Now ABR stream display should be fixed
This commit is contained in:
parent
ab7435f7d7
commit
a2b9ff1da1
163
trees.ml
163
trees.ml
|
@ -551,23 +551,23 @@ let rec print_path pt = match pt with
|
||||||
let update_col tr path v = match path with
|
let update_col tr path v = match path with
|
||||||
| [] -> failwith "Not possible"
|
| [] -> failwith "Not possible"
|
||||||
| fst::t -> begin
|
| fst::t -> begin
|
||||||
let rec aux t pth isf = match t with
|
let rec aux t pth isf sign = match t with
|
||||||
| Empty -> Empty
|
| Empty -> Empty
|
||||||
| Node (x, p, l, r) -> begin
|
| Node (x, p, l, r) -> begin
|
||||||
match pth with
|
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)
|
| [] -> 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, 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 (-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}, 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}, 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 + 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)
|
| 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 + 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)
|
| 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"
|
| _ -> failwith "Not possible"
|
||||||
end
|
end
|
||||||
in aux tr path true
|
in aux tr path true 1
|
||||||
end ;;
|
end ;;
|
||||||
|
|
||||||
exception CollisionPath of (bal list) ;;
|
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 hash = Hashtbl.create 48 in
|
||||||
let rec aux t d path = match t with
|
let rec aux t d path = match t with
|
||||||
| Empty -> ()
|
| Empty -> ()
|
||||||
|
@ -575,8 +575,14 @@ let rec detect_collision (tr : int abr2) haschanged =
|
||||||
let smth = Hashtbl.find_opt hash (p.x, d) in
|
let smth = Hashtbl.find_opt hash (p.x, d) in
|
||||||
if smth = None then begin
|
if smth = None then begin
|
||||||
Hashtbl.add hash (p.x, d) 1;
|
Hashtbl.add hash (p.x, d) 1;
|
||||||
|
if !side = (-1) then begin
|
||||||
aux l (d+1) (path@[Left]);
|
aux l (d+1) (path@[Left]);
|
||||||
aux r (d+1) (path@[Right]);
|
aux r (d+1) (path@[Right]);
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
aux r (d+1) (path@[Right]);
|
||||||
|
aux l (d+1) (path@[Left]);
|
||||||
|
end
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
raise (CollisionPath path)
|
raise (CollisionPath path)
|
||||||
|
@ -587,11 +593,92 @@ let rec detect_collision (tr : int abr2) haschanged =
|
||||||
haschanged := false;
|
haschanged := false;
|
||||||
tr;
|
tr;
|
||||||
with
|
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 =
|
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 raw_print (tr : int abr2) =
|
||||||
let rec aux t d = match t with
|
let rec aux t d = match t with
|
||||||
|
@ -655,29 +742,61 @@ let rec insert_abr2 (tr : int abr2) e =
|
||||||
| Node (x, p, g, d) -> Node (x, p, g, aux d p Right)
|
| Node (x, p, g, d) -> Node (x, p, g, aux d p Right)
|
||||||
in aux tr {x = 0; y = 0} Root ;;
|
in aux tr {x = 0; y = 0} Root ;;
|
||||||
|
|
||||||
let successive_insert2 () =
|
let successive_insert_semiauto () =
|
||||||
let cur_tree = ref Empty in
|
let cur_tree = ref Empty in
|
||||||
open_graph " 1400x1000" ;
|
open_graph " 1400x1000" ;
|
||||||
set_window_title "Trees" ;
|
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
|
try
|
||||||
while true do
|
while true do
|
||||||
Stdlib.print_endline "What element would you like to insert ?";
|
for i = 0 to period-1 do
|
||||||
let elt = Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity in
|
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" ;
|
open_graph " 1200x1000" ;
|
||||||
set_window_title "Trees" ;
|
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
|
let changed = ref true in
|
||||||
cur_tree := detect_collision !cur_tree changed;
|
|
||||||
|
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;
|
done;
|
||||||
|
|
||||||
(*raw_print !cur_tree ;*)
|
Stdlib.print_endline "Enter an integer :";
|
||||||
|
elt_to_add := Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity;
|
||||||
|
|
||||||
print_tree2 !cur_tree 30 1400 1000 ;
|
print_int 0;
|
||||||
|
|
||||||
|
(*raw_print !cur_tree ;*)
|
||||||
done;
|
done;
|
||||||
()
|
()
|
||||||
with
|
with
|
||||||
|
@ -693,7 +812,7 @@ ignore (Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity) ;;
|
||||||
close_graph () ;;
|
close_graph () ;;
|
||||||
failwith "E" ;;
|
failwith "E" ;;
|
||||||
*)
|
*)
|
||||||
successive_insert2 () ;;
|
successive_insert_semiauto () ;;
|
||||||
|
|
||||||
open_graph " 1800x1000" ;;
|
open_graph " 1800x1000" ;;
|
||||||
set_window_title "Trees" ;;
|
set_window_title "Trees" ;;
|
||||||
|
|
Loading…
Reference in New Issue