mp2i-vms.fr
833 lines
28 KiB
OCaml
833 lines
28 KiB
OCaml
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 *)
|
|
set_line_width (max 1 (r/10));
|
|
let n = ref n0 in
|
|
let size = ln10 n0 in
|
|
let len = r/3 in
|
|
let offset = size*(len*11/7)/2 in
|
|
for i = 0 to size do
|
|
let x = x0 + offset - i*(len*11/7) 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 (max 1 (r/6)) ;
|
|
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 when k = maxd -> Node (Random.int 1000, aux (maxd-1), aux (maxd-1))
|
|
| 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 ;;
|
|
|
|
(* NEW VERSION *)
|
|
|
|
type pt = {x : int ; y :int} ;;
|
|
type node_data = {tag : int ; parent : pt ; self : pt} ;;
|
|
|
|
type 'a data_tree = Nothing | Tail of node_data | Cross of node_data * 'a data_tree * 'a data_tree ;;
|
|
(* changing names to avoid confusion *)
|
|
|
|
let count_per_floor tr =
|
|
let d = depth_of_tree tr in
|
|
let res = Array.make d 0 in
|
|
let rec aux tr dpth = match tr with
|
|
| Empty -> ()
|
|
| Leaf _ -> res.(dpth) <- res.(dpth) + 1
|
|
| Node (_, g, d) -> res.(dpth) <- res.(dpth) + 1 ; aux g (dpth+1) ; aux d (dpth+1)
|
|
in aux tr 0 ; res ;;
|
|
|
|
let showtree tdt r =
|
|
let rec aux t side = match t with
|
|
| Nothing -> ()
|
|
| Tail data -> begin
|
|
set_line_width 9;
|
|
if side = 1 then set_color (rgb 200 48 48) else set_color (rgb 48 48 200) ;
|
|
draw_poly_line [|(data.parent.x, data.parent.y); (data.self.x, data.self.y)|];
|
|
|
|
set_color (rgb 192 192 192);
|
|
fill_circle data.self.x data.self.y r;
|
|
|
|
set_color (rgb 32 192 32);
|
|
set_line_width 7;
|
|
draw_circle data.self.x data.self.y r;
|
|
|
|
set_color black;
|
|
set_line_width 5;
|
|
draw_integer data.self.x data.self.y data.tag r;
|
|
end
|
|
| Cross (data, g, d) -> begin
|
|
set_line_width 9;
|
|
if side = 1 then set_color (rgb 200 48 48) else set_color (rgb 48 48 200) ;
|
|
draw_poly_line [|(data.parent.x, data.parent.y); (data.self.x, data.self.y)|];
|
|
|
|
aux g (-1);
|
|
aux d 1;
|
|
|
|
set_color (rgb 192 192 192);
|
|
fill_circle data.self.x data.self.y r;
|
|
|
|
set_color (rgb 192 192 32);
|
|
set_line_width 7;
|
|
draw_circle data.self.x data.self.y r;
|
|
|
|
set_color black;
|
|
set_line_width 5;
|
|
draw_integer data.self.x data.self.y data.tag r;
|
|
end
|
|
in aux tdt 0 ;;
|
|
|
|
let coords_on_segment a b divsize k =
|
|
if divsize <> 0 then
|
|
a + k*(b-a)/divsize
|
|
else (a + b)/2 ;;
|
|
|
|
let max_of_arr a =
|
|
let m = ref a.(0) in
|
|
for i = 1 to (Array.length a -1) do
|
|
if !m < a.(i) then m := a.(i)
|
|
done; !m ;;
|
|
|
|
let pretty_tree_printing_new_version tr r ystep win_w win_h display =
|
|
let d = depth_of_tree tr in
|
|
let amt_per_floor = count_per_floor tr in
|
|
|
|
let visited_fl = Array.make d 0 in
|
|
(* visited.(x) count the number of already visited nodes in floor x *)
|
|
|
|
let rec build_data_tree tr dpth parent_xy =
|
|
match tr with
|
|
| Empty -> Nothing
|
|
| Leaf x -> begin
|
|
(*let self = {x = win_w/2 - (14*r/6)*amt_per_floor.(dpth)/2 + (14*r/6)*visited_fl.(dpth); y = win_h - r/2 - (dpth)*ystep} in*)
|
|
let self = {x = coords_on_segment (max r (win_w/2 - 2*r*(pw 2 dpth))) (min (win_w - r) (win_w/2 + 2*r*(pw 2 dpth))) (amt_per_floor.(dpth)-1) visited_fl.(dpth); y = win_h - r/2 - (dpth)*ystep} in
|
|
visited_fl.(dpth) <- visited_fl.(dpth) + 1;
|
|
let data = {tag = x ; parent = parent_xy ; self = self} in
|
|
Tail (data)
|
|
end
|
|
| Node (x, g, d) -> begin
|
|
(*let self = {x = win_w/2 - (14*r/6)*amt_per_floor.(dpth)/2 + (14*r/6)*visited_fl.(dpth); y = win_h - r/2 - (dpth)*ystep} in*)
|
|
let self = {x = coords_on_segment (max r (win_w/2 - 2*r*(pw 2 dpth))) (min (win_w - r) (win_w/2 + 2*r*(pw 2 dpth))) (amt_per_floor.(dpth)-1) visited_fl.(dpth); y = win_h - r/2 - (dpth)*ystep} in
|
|
visited_fl.(dpth) <- visited_fl.(dpth) + 1;
|
|
if dpth <> 0 then begin
|
|
let data = {tag = x ; parent = parent_xy ; self = self} in
|
|
let arg_left = build_data_tree g (dpth+1) self in
|
|
let arg_right = build_data_tree d (dpth+1) self in
|
|
(* PS : this is a good example of OCaml evaluating its arguments from right to left *)
|
|
(* if the recursive call were to be directly inside the constructor, the displayed tree would be reversed *)
|
|
Cross (data, arg_left, arg_right)
|
|
end else begin
|
|
let data = {tag = x ; parent = self ; self = self} in
|
|
let arg_left = build_data_tree g (dpth+1) self in
|
|
let arg_right = build_data_tree d (dpth+1) self in
|
|
Cross (data, arg_left, arg_right)
|
|
end
|
|
end
|
|
in
|
|
let treedata = build_data_tree tr 0 {x = win_w/2 ; y = win_h - r} in
|
|
if display then showtree treedata r; treedata ;;
|
|
|
|
(* NEW NEW display *)
|
|
(*
|
|
The screen is viewed as a grid with (0, 0) being located at (width/2, height - r)
|
|
*)
|
|
|
|
exception CollisionDetected of int ;;
|
|
|
|
let identity n = n ;;
|
|
|
|
type node = {parent : pt; self : pt; tag : int} ;;
|
|
|
|
type lr = Root | Left | Right ;;
|
|
|
|
let is_collision_at_layer (l : node list) depth =
|
|
let hash = Hashtbl.create 16 in
|
|
let rec aux l = match l with
|
|
| [] -> ()
|
|
| h::t -> begin
|
|
let is_f = Hashtbl.find_opt hash (h.self.x) in
|
|
if is_f = None then begin
|
|
Hashtbl.add hash (h.self.x) 1;
|
|
aux t
|
|
end
|
|
else
|
|
raise (CollisionDetected depth)
|
|
end
|
|
in
|
|
aux l;;
|
|
|
|
let is_collision (mat : node list array) =
|
|
try
|
|
for i = 0 to (Array.length mat -1) do
|
|
is_collision_at_layer mat.(i) i
|
|
done;
|
|
None
|
|
with
|
|
| CollisionDetected x -> Some x ;;
|
|
|
|
let rec singlepass_sort (l : node list) = match l with
|
|
| [] -> Stdlib.print_endline "]"; []
|
|
| h::[] -> Printf.printf "(%d : [%d, %d]) \n" h.tag h.self.x h.self.y; h::[]
|
|
| h1::h2::t -> begin
|
|
Printf.printf "(%d : [%d, %d]) " h1.tag h1.self.x h1.self.y ;
|
|
if h2.tag > h1.tag && h2.self.x < h1.self.x then begin
|
|
let nh1 = {parent = h1.parent ; self = h2.self ; tag = h1.tag} in
|
|
let nh2 = {parent = h2.parent ; self = h1.self ; tag = h2.tag} in
|
|
nh1::(singlepass_sort (nh2::t))
|
|
end
|
|
else
|
|
h1::(singlepass_sort (h2::t))
|
|
end ;;
|
|
|
|
let sortify (mat : node list array) =
|
|
for i = 0 to (Array.length mat -1) do
|
|
mat.(i) <- singlepass_sort mat.(i)
|
|
done ;;
|
|
|
|
let encode_tree_into_mat tr current_increment =
|
|
let d = depth_of_tree tr in
|
|
let clist = Array.make d [] in
|
|
for i = 0 to d-1 do
|
|
clist.(i) <- []
|
|
done;
|
|
|
|
let rec fill t d dad where = match t with
|
|
| Empty -> ()
|
|
| Leaf x -> begin
|
|
let self_x = ref dad.x in
|
|
if where = Left then
|
|
self_x := dad.x - current_increment.(d)*2
|
|
else if where = Right then
|
|
self_x := dad.x + current_increment.(d)*2;
|
|
|
|
let self = {x = !self_x ; y = -d} in
|
|
clist.(d) <- (clist.(d))@[{parent = dad ; self = self; tag = x}]
|
|
end
|
|
| Node (x, left, right) -> begin
|
|
let self_x = ref dad.x in
|
|
if where = Left then
|
|
self_x := dad.x - current_increment.(d)
|
|
else if where = Right then
|
|
self_x := dad.x + current_increment.(d);
|
|
|
|
let self = {x = !self_x ; y = -d} in
|
|
fill left (d+1) self Left;
|
|
|
|
clist.(d) <- (clist.(d))@[{parent = dad ; self = self; tag = x}];
|
|
|
|
fill right (d+1) self Right
|
|
end
|
|
in
|
|
fill tr 0 {x = 0; y = 0} Root;
|
|
(*sortify clist;*)
|
|
match is_collision clist with
|
|
| Some x -> raise (CollisionDetected x)
|
|
| None -> clist ;;
|
|
|
|
let decode_pt (p : pt) r width height =
|
|
(width/2 + p.x * r, height - r + (2*r)*p.y) ;;
|
|
|
|
let rec print_edges (l : node list) r width height = match l with
|
|
| [] -> ()
|
|
| nod::t -> begin
|
|
let (xd, yd) = decode_pt nod.self r width height in
|
|
let (xp, yp) = decode_pt nod.parent r width height in
|
|
|
|
set_color (rgb 128 128 128);
|
|
set_line_width (max 1 (r/3));
|
|
draw_poly_line [|(xd, yd); (xp, yp)|];
|
|
|
|
print_edges t r width height;
|
|
end ;;
|
|
|
|
let rec print_vertexes (l : node list) r width height = match l with
|
|
| [] -> ()
|
|
| nod::t -> begin
|
|
let (xd, yd) = decode_pt nod.self r width height in
|
|
|
|
print_vertexes t r width height;
|
|
|
|
set_color black;
|
|
set_line_width 5;
|
|
draw_circle xd yd r;
|
|
|
|
set_color (rgb 32 192 32);
|
|
fill_circle xd yd r;
|
|
|
|
set_color black;
|
|
set_line_width (max 1 (r/10));
|
|
draw_integer xd yd nod.tag r;
|
|
end ;;
|
|
|
|
let print_encoded (a : node list array) r width height =
|
|
for i = 0 to (Array.length a -1) do
|
|
print_edges a.(i) r width height;
|
|
done;
|
|
for i = 0 to (Array.length a -1) do
|
|
print_vertexes a.(i) r width height;
|
|
done ;;
|
|
|
|
let rec yet_another_printing tr r width height current_increment =
|
|
try
|
|
print_encoded (encode_tree_into_mat tr current_increment) r width height;
|
|
with
|
|
| CollisionDetected ly -> begin
|
|
current_increment.(ly-1) <- current_increment.(ly-1) + 2;
|
|
for i = 0 to 19 do
|
|
Printf.printf "- %d " current_increment.(i)
|
|
done;
|
|
Unix.sleepf 0.25;
|
|
Stdlib.print_endline "E";
|
|
Printf.printf "{%d}\n" ly ;
|
|
yet_another_printing tr r width height current_increment
|
|
end ;;
|
|
|
|
let finalized_printing tr r width height cincr =
|
|
yet_another_printing tr r width height cincr ;;
|
|
|
|
(* ABR things *)
|
|
|
|
let rec insert_abr tr e = match tr with
|
|
| Empty -> Node (e, Empty, Empty)
|
|
| Leaf t when e < t -> Node (t, (Node (e, Empty, Empty)), Empty)
|
|
| Leaf t -> Node (t, Empty, (Node (e, Empty, Empty)))
|
|
| Node (x, g, d) when e < x -> Node (x, insert_abr g e, d)
|
|
| Node (x, g, d) -> Node (x, g, insert_abr d e) ;;
|
|
|
|
let successive_insert () =
|
|
let cur_tree = ref (Empty) in
|
|
open_graph " 1600x1000" ;
|
|
set_window_title "Trees" ;
|
|
|
|
try
|
|
let current_increment = Array.make 20 1 in
|
|
while true do
|
|
Stdlib.print_endline "What element would you like to insert ? (crash to terminate)";
|
|
let elt = Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity in
|
|
|
|
cur_tree := insert_abr !cur_tree elt;
|
|
|
|
open_graph " 1600x1000" ;
|
|
set_window_title "Trees" ;
|
|
(*ignore (pretty_tree_printing_new_version !cur_tree 40 100 1200 1000 true)*)
|
|
(*ignore (even_more_pretty_printing !cur_tree 20 100 false);*)
|
|
finalized_printing !cur_tree 30 1600 1000 current_increment;
|
|
|
|
for i = 0 to 19 do
|
|
Printf.printf "| %d " current_increment.(i)
|
|
done;
|
|
print_char '\n';
|
|
done;
|
|
()
|
|
with
|
|
| Stdlib.Scanf.Scan_failure _ -> close_graph () ;;
|
|
|
|
(* HERE WE GO AGAIN *)
|
|
|
|
type 'a abr2 = Empty | Node of 'a * pt * 'a abr2 * 'a abr2 ;;
|
|
|
|
type bal = Root | Left | Right ;;
|
|
|
|
let rec print_path pt = match pt with
|
|
| [] -> print_char '\n'
|
|
| Left::t -> Printf.printf "LEFT -> "; print_path t
|
|
| Right::t -> Printf.printf "RIGHT -> "; print_path t
|
|
| _ -> () ;;
|
|
|
|
let update_col tr path v = match path with
|
|
| [] -> failwith "Not possible"
|
|
| fst::t -> begin
|
|
let rec aux t pth isf sign = match t with
|
|
| Empty -> Empty
|
|
| Node (x, p, l, r) -> begin
|
|
match pth with
|
|
| [] -> if isf then Node (x, {x = p.x; y = p.y}, aux l [] false sign, aux r [] false sign) else Node (x, {x = p.x + v*sign; y = p.y}, aux l [] false sign, aux r [] false sign)
|
|
| Left::[] -> if isf then Node (x, {x = p.x; y = p.y}, aux l [] false (-1), r) else Node (x, {x = p.x + v; y = p.y}, aux l [] false (-1), r)
|
|
| Right::[] -> if isf then Node (x, {x = p.x; y = p.y}, l, aux r [] false 1) else Node (x, {x = p.x + v; y = p.y}, l, aux r [] false 1)
|
|
| Left::t -> if isf then Node (x, {x = p.x ; y = p.y}, aux l t false (-1), r) else Node (x, {x = p.x + v; y = p.y}, aux l t false (-1), aux r [] false (-1))
|
|
| Right::t -> if isf then Node (x, {x = p.x ; y = p.y}, l, aux r t false 1) else Node (x, {x = p.x + v; y = p.y}, aux l [] false 1, aux r t false 1)
|
|
| _ -> failwith "Not possible"
|
|
end
|
|
in aux tr path true 1
|
|
end ;;
|
|
|
|
exception CollisionPath of (bal list) ;;
|
|
|
|
let rec detect_collision (tr : int abr2) haschanged (side : int ref) =
|
|
let hash = Hashtbl.create 48 in
|
|
let rec aux t d path = match t with
|
|
| Empty -> ()
|
|
| Node (x, p, l, r) -> begin
|
|
let smth = Hashtbl.find_opt hash (p.x, d) in
|
|
if smth = None then begin
|
|
Hashtbl.add hash (p.x, d) 1;
|
|
if !side = (-1) then begin
|
|
aux l (d+1) (path@[Left]);
|
|
aux r (d+1) (path@[Right]);
|
|
end
|
|
else begin
|
|
aux r (d+1) (path@[Right]);
|
|
aux l (d+1) (path@[Left]);
|
|
end
|
|
end
|
|
else
|
|
raise (CollisionPath path)
|
|
end
|
|
in
|
|
try
|
|
aux tr 0 [];
|
|
haschanged := false;
|
|
tr;
|
|
with
|
|
| CollisionPath pth -> haschanged := true; side := (-1) * !side; update_col tr pth 4 ;;
|
|
|
|
exception Collision2 of (bal list * bal list) ;;
|
|
|
|
let youngest_dad path1 path2 =
|
|
let rec aux l1 l2 c = match (l1, l2) with
|
|
| ([], []) -> c
|
|
| ([], h::t) -> c
|
|
| (h::t, []) -> c
|
|
| (Left::t1, Right::t2) -> c
|
|
| (Right::t1, Left::t2) -> c
|
|
| (Left::t1, Left::t2) -> aux t1 t2 (c@[Left])
|
|
| (Right::t1, Right::t2) -> aux t1 t2 (c@[Right])
|
|
| _ -> failwith "Huh ?"
|
|
in aux path1 path2 [] ;;
|
|
|
|
let get_first_offset p1 p2 = match (p1, p2) with
|
|
| (Left::t1, Left::t2) -> (-1, 0)
|
|
| (Right::t1, Right::t2) -> (0, 1)
|
|
| (Left::t1, Right::t2) -> (0, 0)
|
|
| (Right::t1, Left::t2) -> (0, 0)
|
|
| _ -> (0, 0) ;;
|
|
|
|
let remove_first l = match l with
|
|
| [] -> failwith "Undoable"
|
|
| h::t -> t ;;
|
|
|
|
let rec update_col2 tr p1 p2 v =
|
|
let dadpath = youngest_dad p1 p2 in
|
|
let (left_add, right_add) = get_first_offset p1 p2 in
|
|
(*Printf.printf "%d, %d\n" left_add right_add ;
|
|
print_path dadpath;*)
|
|
let rec aux t remain_path where offs = match t with
|
|
| Empty -> Empty
|
|
| Node (x, p, l, r) -> begin
|
|
match remain_path with
|
|
| Left::rem -> Node (x, {x = p.x + offs ; y = p.y}, aux l rem Root offs, r)
|
|
| Right::rem -> Node (x, {x = p.x + offs ; y = p.y}, l, aux r rem Root offs)
|
|
| [] -> begin
|
|
if where = Root then
|
|
Node (x, {x = p.x + offs; y = p.y}, aux l [] Left offs, aux r [] Right offs)
|
|
else if where = Left then
|
|
Node (x, {x = p.x - v + offs; y = p.y}, aux l [] Left offs, aux r [] Left offs)
|
|
else
|
|
Node (x, {x = p.x + v + offs; y = p.y}, aux l [] Right offs, aux r [] Right offs)
|
|
end
|
|
| _ -> failwith "Nani ?"
|
|
end
|
|
in match tr with
|
|
| Empty -> Empty
|
|
| Node (x, p, l, r) -> match dadpath with
|
|
| h::remdad -> Node (x, p, aux l remdad Root (v*left_add), aux r remdad Root (v*right_add))
|
|
| [] -> Node (x, p, aux l [] Left (v*left_add), aux r [] Right (v*right_add)) ;;
|
|
|
|
let rec detect_collision2 (tr : int abr2) haschanged (side : int ref) =
|
|
let hash = Hashtbl.create 48 in
|
|
let rec aux t d path = match t with
|
|
| Empty -> ()
|
|
| Node (x, p, l, r) -> begin
|
|
let smth = Hashtbl.find_opt hash (p.x, d) in
|
|
if smth = None then begin
|
|
Hashtbl.add hash (p.x, d) path;
|
|
if !side = (-1) then begin
|
|
aux l (d+1) (path@[Left]);
|
|
aux r (d+1) (path@[Right]);
|
|
end
|
|
else begin
|
|
aux r (d+1) (path@[Right]);
|
|
aux l (d+1) (path@[Left]);
|
|
end
|
|
end
|
|
else match smth with
|
|
| None -> ()
|
|
| Some opath -> raise (Collision2 (path, opath))
|
|
end
|
|
in
|
|
try
|
|
aux tr 0 [];
|
|
haschanged := false;
|
|
tr;
|
|
with
|
|
| Collision2 (p1, p2) -> haschanged := true; update_col2 tr p1 p2 4 ;;
|
|
|
|
|
|
let decode2 (p : pt) r width height =
|
|
(width/2 + (1+p.x)/2 * r, height - r - (3*r)*p.y) ;;
|
|
|
|
let raw_print (tr : int abr2) =
|
|
let rec aux t d = match t with
|
|
| Empty -> ()
|
|
| Node (x, p, l, r) -> begin
|
|
Printf.printf "[layer %d : (%d, [%d %d])]\n" d x p.x p.y;
|
|
aux l (d+1);
|
|
aux r (d+1)
|
|
end
|
|
in aux tr 0 ;;
|
|
|
|
let print_tree2 (tr : int abr2) r width height =
|
|
let rec aux_ver t dad isf = match t with
|
|
| Empty -> ()
|
|
| Node (e, pt, g, d) -> begin
|
|
let (xp, yp) = decode2 pt r width height in
|
|
let (xd, yd) = decode2 dad r width height in
|
|
set_color (rgb 128 128 128);
|
|
set_line_width (max 1 (r/3));
|
|
|
|
if isf = false then
|
|
draw_poly_line [|(xd, yd); (xp, yp)|];
|
|
|
|
aux_ver g pt false;
|
|
aux_ver d pt false;
|
|
end
|
|
in
|
|
let rec aux_edg t = match t with
|
|
| Empty -> ()
|
|
| Node (e, pt, g, d) -> begin
|
|
let (xp, yp) = decode2 pt r width height in
|
|
|
|
set_color (rgb 128 128 128);
|
|
fill_circle xp yp r;
|
|
|
|
set_color black;
|
|
set_line_width (max 1 (r/6));
|
|
draw_circle xp yp r;
|
|
|
|
set_color (rgb 32 255 32);
|
|
set_line_width (max 1 (r/6));
|
|
draw_integer xp yp e r;
|
|
|
|
aux_edg g;
|
|
aux_edg d;
|
|
end
|
|
in
|
|
aux_ver tr {x = 0; y = 0} true;
|
|
aux_edg tr ;;
|
|
|
|
let rec insert_abr2 (tr : int abr2) e =
|
|
let rec aux t dad side = match t with
|
|
| Empty ->
|
|
if side = Root then
|
|
Node (e, dad, Empty, Empty)
|
|
else if side = Left then
|
|
Node (e, {x = dad.x - 2; y = dad.y + 1}, Empty, Empty)
|
|
else
|
|
Node (e, {x = dad.x + 2; y = dad.y + 1}, Empty, Empty)
|
|
| Node (x, p, g, d) when e < x -> Node (x, p, aux g p Left, d)
|
|
| Node (x, p, g, d) -> Node (x, p, g, aux d p Right)
|
|
in aux tr {x = 0; y = 0} Root ;;
|
|
|
|
let successive_insert_semiauto () =
|
|
let cur_tree = ref Empty in
|
|
open_graph " 1600x1000" ;
|
|
set_window_title "Trees" ;
|
|
|
|
let radius = 20 in
|
|
|
|
let period = 10 in
|
|
let sided = ref 1 in
|
|
let ct = ref 0 in
|
|
|
|
let elt_to_add = ref 500 in
|
|
|
|
cur_tree := insert_abr2 !cur_tree 500;
|
|
cur_tree := insert_abr2 !cur_tree 250;
|
|
cur_tree := insert_abr2 !cur_tree 750;
|
|
|
|
try
|
|
while true do
|
|
for i = 0 to period-1 do
|
|
elt_to_add := Random.int 1000 ;
|
|
(*Stdlib.print_endline "Enter an integer :";
|
|
elt_to_add := Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity;*)
|
|
|
|
open_graph " 1600x1000" ;
|
|
set_window_title "Trees" ;
|
|
|
|
ct := 0;
|
|
|
|
cur_tree := insert_abr2 !cur_tree !elt_to_add;
|
|
|
|
let changed = ref true in
|
|
|
|
while !changed do
|
|
cur_tree := detect_collision2 !cur_tree changed sided;
|
|
(*print_int !ct;
|
|
Stdlib.print_endline "[]";*)
|
|
incr ct;
|
|
|
|
open_graph " 1600x1000" ;
|
|
set_window_title "Trees" ;
|
|
|
|
print_tree2 !cur_tree radius 1600 1000 ;
|
|
done;
|
|
|
|
print_tree2 !cur_tree radius 1600 1000 ;
|
|
Unix.sleepf 0.04;
|
|
done;
|
|
|
|
Stdlib.print_endline "Enter an integer to add 10 more :";
|
|
ignore (Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity);
|
|
|
|
(*raw_print !cur_tree ;*)
|
|
done;
|
|
()
|
|
with
|
|
| Stdlib.Scanf.Scan_failure _ -> close_graph () ;;
|
|
|
|
(* --------------------------------------| TESTS |-------------------------------------- *)
|
|
Random.self_init () ;;
|
|
(*
|
|
open_graph " 1800x1000" ;;
|
|
set_window_title "Trees" ;;
|
|
ignore (pretty_tree_printing_new_version (Node (0, Node (1, (Node (0, Node (1, Empty, Empty), Node (2, Empty, Empty))), Empty), Node (2, Empty, (Node (0, Node (1, Empty, Empty), Node (2, Empty, Empty)))))) 40 150 1800 1000 true) ;;
|
|
ignore (Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity) ;;
|
|
close_graph () ;;
|
|
failwith "E" ;;
|
|
*)
|
|
successive_insert_semiauto () ;;
|
|
|
|
open_graph " 1800x1000" ;;
|
|
set_window_title "Trees" ;;
|
|
|
|
let tt = generate_some_tree 5 75 100 ;;
|
|
|
|
ignore (pretty_tree_printing_new_version tt 40 150 1800 1000 true) ;;
|
|
|
|
ignore (Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity) ;;
|
|
(*
|
|
let gdata = even_more_pretty_printing tt 30 150 false ;;
|
|
|
|
even_more_fancy_dfs_prefixe tt gdata 30 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' ;; |