Less clunky printing

trees.ml

@@ -341,10 +341,141 @@ let pretty_tree_printing_new_version tr r ystep win_w win_h display =
     let treedata = build_data_tree tr 0 {x = win_w/2 ; y = win_h - r} in 
     if display then showtree treedata r; treedata ;;
 
-(* ABR things *)
+(* 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 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)
+            else if where = Right then
+                self_x := dad.x + current_increment.(d);
+            
+            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;
+    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 255 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;
+            yet_another_printing tr r width height current_increment
+        end ;;
+
+let finalized_printing tr r width height =
+    yet_another_printing tr r width height (Array.make (depth_of_tree tr) 2) ;;
+
+(* 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)
@@ -366,11 +497,12 @@ let successive_insert () =
 
             cur_tree := insert_abr !cur_tree elt;
             (*ignore (pretty_tree_printing_new_version !cur_tree 40 100 1200 1000 true)*)
-            ignore (even_more_pretty_printing !cur_tree 20 100 false);
+            (*ignore (even_more_pretty_printing !cur_tree 20 100 false);*)
+            finalized_printing !cur_tree 30 1400 1000;
         done;
         ()
     with
-        | Stdlib.Scanf.Scan_failure _ -> ignore (even_more_pretty_printing !cur_tree 20 100 false) ;close_graph () ;;
+        | Stdlib.Scanf.Scan_failure _ -> finalized_printing !cur_tree 30 1400 1000;close_graph () ;;
 
 (* --------------------------------------| TESTS |-------------------------------------- *)
 Random.self_init () ;;