diff --git a/a.out b/a.out index 73eb009..fbb0ce2 100755 Binary files a/a.out and b/a.out differ diff --git a/trees.cmi b/trees.cmi index 3136f97..073098d 100644 Binary files a/trees.cmi and b/trees.cmi differ diff --git a/trees.cmo b/trees.cmo index 4f2ce08..ee19288 100644 Binary files a/trees.cmo and b/trees.cmo differ diff --git a/trees.ml b/trees.ml index 463184a..b150b0d 100644 --- a/trees.ml +++ b/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 () ;;