diff --git a/a.out b/a.out index fbb0ce2..96bce02 100755 Binary files a/a.out and b/a.out differ diff --git a/trees.cmi b/trees.cmi index 073098d..aba4cab 100644 Binary files a/trees.cmi and b/trees.cmi differ diff --git a/trees.cmo b/trees.cmo index ee19288..b6df1d5 100644 Binary files a/trees.cmo and b/trees.cmo differ diff --git a/trees.ml b/trees.ml index b150b0d..5cfb4bb 100644 --- a/trees.ml +++ b/trees.ml @@ -379,6 +379,25 @@ let is_collision (mat : node list array) = 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 @@ -391,9 +410,9 @@ let encode_tree_into_mat tr current_increment = | Leaf x -> begin let self_x = ref dad.x in if where = Left then - self_x := dad.x - current_increment.(d) + self_x := dad.x - current_increment.(d)*2 else if where = Right then - self_x := dad.x + current_increment.(d); + 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}] @@ -414,6 +433,7 @@ let encode_tree_into_mat tr current_increment = end in fill tr 0 {x = 0; y = 0} Root; + (*sortify clist;*) match is_collision clist with | Some x -> raise (CollisionDetected x) | None -> clist ;; @@ -464,15 +484,20 @@ let print_encoded (a : node list array) r width height = 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; + 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 = - yet_another_printing tr r width height (Array.make (depth_of_tree tr) 2) ;; +let finalized_printing tr r width height cincr = + yet_another_printing tr r width height cincr ;; (* ABR things *) @@ -487,22 +512,174 @@ let successive_insert () = let cur_tree = ref (Empty) in open_graph " 1400x1000" ; 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 " 1200x1000" ; + 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 1400 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 = 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, aux r [] false) else Node (x, {x = p.x + v; y = p.y}, aux l [] false, aux r [] false) + | Left::t -> if isf then Node (x, {x = p.x + v/2; y = p.y}, aux l t false, r) else Node (x, {x = p.x + v; y = p.y}, aux l t false, r) + | Right::t -> if isf then Node (x, {x = p.x + v/2; y = p.y}, l, aux r t false) else Node (x, {x = p.x + v; y = p.y}, l, aux r t false) + | _ -> failwith "Not possible" + end + in aux tr path true + end ;; + +exception CollisionPath of (bal list) ;; + +let rec detect_collision (tr : int abr2) haschanged = + 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; + aux l (d+1) (path@[Left]); + aux r (d+1) (path@[Right]); + end + else + raise (CollisionPath path) + end + in + try + aux tr 0 []; + haschanged := false; + tr; + with + | CollisionPath pth -> haschanged := true; update_col tr pth 4 ;; + + +let decode2 (p : pt) r width height = + (width/3 + p.x * r, height - r - (2*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_insert2 () = + let cur_tree = ref Empty in + open_graph " 1400x1000" ; + set_window_title "Trees" ; + try + while true do + Stdlib.print_endline "What element would you like to insert ?"; + let elt = Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity in + open_graph " 1200x1000" ; set_window_title "Trees" ; - 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);*) - finalized_printing !cur_tree 30 1400 1000; + cur_tree := insert_abr2 !cur_tree elt; + + let changed = ref true in + + while !changed do + cur_tree := detect_collision !cur_tree changed; + done; + + (*raw_print !cur_tree ;*) + + print_tree2 !cur_tree 30 1400 1000 ; done; () with - | Stdlib.Scanf.Scan_failure _ -> finalized_printing !cur_tree 30 1400 1000;close_graph () ;; + | Stdlib.Scanf.Scan_failure _ -> close_graph () ;; (* --------------------------------------| TESTS |-------------------------------------- *) Random.self_init () ;; @@ -514,7 +691,7 @@ ignore (Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity) ;; close_graph () ;; failwith "E" ;; *) -successive_insert () ;; +successive_insert2 () ;; open_graph " 1800x1000" ;; set_window_title "Trees" ;;