mp2i-vms
/
PrettyPrinting
46
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Now ABR stream display should be fixed

This commit is contained in:
Alexandre 2024-06-12 22:36:28 +02:00
parent ab7435f7d7
commit a2b9ff1da1
4 changed files with 142 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
a.out
View File

Binary file not shown.

BIN
trees.cmi
View File

Binary file not shown.

BIN
trees.cmo
View File

Binary file not shown.

165
trees.ml
View File

@ -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" ;;