diff --git a/a.out b/a.out index 4c7d6a4..6a07ba2 100755 Binary files a/a.out and b/a.out differ diff --git a/trees.cmi b/trees.cmi index 362a8c9..fcd6e87 100644 Binary files a/trees.cmi and b/trees.cmi differ diff --git a/trees.cmo b/trees.cmo index 1f34d8b..4cb0dae 100644 Binary files a/trees.cmo and b/trees.cmo differ diff --git a/trees.ml b/trees.ml index f8026a1..d7d316b 100644 --- a/trees.ml +++ b/trees.ml @@ -551,23 +551,23 @@ let rec print_path pt = match pt with let update_col tr path v = match path with | [] -> failwith "Not possible" | fst::t -> begin - let rec aux t pth isf = match t with + 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, aux r [] false) else Node (x, {x = p.x + v; y = p.y}, aux l [] false, aux r [] false) - | Left::[] -> 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) - | Right::[] -> 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) + | [] -> 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 + in aux tr path true 1 end ;; exception CollisionPath of (bal list) ;; -let rec detect_collision (tr : int abr2) haschanged = +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 -> () @@ -575,8 +575,14 @@ let rec detect_collision (tr : int abr2) haschanged = 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) @@ -587,11 +593,92 @@ let rec detect_collision (tr : int abr2) haschanged = haschanged := false; tr; with - | CollisionPath pth -> haschanged := true; update_col tr pth 4 ;; + | 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/3 + p.x * r, height - r - (2*r)*p.y) ;; + (width/2 + p.x * r, height - r - (2*r)*p.y) ;; let raw_print (tr : int abr2) = let rec aux t d = match t with @@ -654,30 +741,62 @@ let rec insert_abr2 (tr : int abr2) e = | 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 successive_insert_semiauto () = let cur_tree = ref Empty in open_graph " 1400x1000" ; 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 !elt_to_add; 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 + 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 " 1200x1000" ; - set_window_title "Trees" ; + open_graph " 1200x1000" ; + set_window_title "Trees" ; - cur_tree := insert_abr2 !cur_tree elt; + ct := 0; - let changed = ref true in + cur_tree := insert_abr2 !cur_tree !elt_to_add; - while !changed do - cur_tree := detect_collision !cur_tree changed; + 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 " 1200x1000" ; + set_window_title "Trees" ; + + print_tree2 !cur_tree radius 1400 1000 ; + + if !changed then + Unix.sleepf 0.5; + done; + + print_tree2 !cur_tree radius 1400 1000 ; + Unix.sleepf 0.1; done; + Stdlib.print_endline "Enter an integer :"; + elt_to_add := Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity; + + print_int 0; + (*raw_print !cur_tree ;*) - - print_tree2 !cur_tree 30 1400 1000 ; done; () with @@ -693,7 +812,7 @@ ignore (Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity) ;; close_graph () ;; failwith "E" ;; *) -successive_insert2 () ;; +successive_insert_semiauto () ;; open_graph " 1800x1000" ;; set_window_title "Trees" ;;