PrettyPrinting/pretty_printing.ml

602 lines
21 KiB
OCaml

(*open Spectrum*)
let rec print_mat m =
for i = 0 to (Array.length m)-1 do
print_char ' ';
for j = 0 to (Array.length m.(i))-1 do
if m.(i).(j) <> -1 then
print_int m.(i).(j)
else
print_char '_';
print_char ' ';
print_char '|';
print_char ' ';
done;
print_char '\n';
for j = 0 to (Array.length m.(i))-1 do
print_char '-';
print_char '-';
print_char '-';
print_char '+';
done;
print_char '\n';
done ;;
exception ReturnBool of bool ;;
let pi = 3.14159265358979343 ;;
let abs x =
if x >= 0 then x else -x ;;
let absf x =
if x >= 0. then x else -1. *. x ;;
let is_rempaceable c arr =
try
for i = 0 to (Array.length arr - 1) do
if c = arr.(i) then
raise (ReturnBool true)
else
()
done;
raise (ReturnBool false)
with
| ReturnBool b -> b ;;
let draw_line_bresenham mat cls origin x1 y1 x2 y2 cutoff =
let slope = ref 0. in
let override_arr = [|' '; '.'; '|'; '-'|] in
if x2 <> x1 || y2 <> y1 then
slope := (float_of_int (y2 - y1) /. float_of_int (x2 - x1))
else
();
(*Printf.printf "(%f)\n" !slope;*)
if absf (!slope) < 1. then
if x1 < x2 then
for k = x1 to x2 do
let cur_y = ref ((!slope) *. float_of_int (k - x1) +. float_of_int y1) in
if !slope = 0. then cur_y := float_of_int y2 else ();
if is_rempaceable mat.(k).(int_of_float (!cur_y)) override_arr then begin
if x2 - k <= cutoff || k mod 2 = 0 || cls.(k).(int_of_float (!cur_y)) = 0 then
cls.(k).(int_of_float (!cur_y)) <- origin+1
else
();
if x2 - k > cutoff then
mat.(k).(int_of_float (!cur_y)) <- '|'
else
mat.(k).(int_of_float (!cur_y)) <- 'v'
end
else
()
done
else
for k = x1 downto x2 do
let cur_y = ref ((!slope) *. float_of_int (k - x1) +. float_of_int y1) in
if !slope = 0. then cur_y := float_of_int y2 else ();
if is_rempaceable mat.(k).(int_of_float (!cur_y)) override_arr then begin
if k - x2 <= cutoff || k mod 2 = 0 || cls.(k).(int_of_float (!cur_y)) = 0 then
cls.(k).(int_of_float (!cur_y)) <- origin+1
else
();
if k - x2 > cutoff then
mat.(k).(int_of_float (!cur_y)) <- '|'
else
mat.(k).(int_of_float (!cur_y)) <- '^'
end
else
()
done
else
if y1 < y2 then
for l = y1 to y2 do
let cur_x = ref (float_of_int x2) in
if (!slope) <> 1.0 /. 0.0 && (!slope) <> (-. 1.) /. 0. then
cur_x := ((float_of_int l) +. ((!slope) *. (float_of_int x1) -. (float_of_int y1))) /. (!slope)
else
();
if is_rempaceable mat.(int_of_float (!cur_x)).(l) override_arr then begin
if y2 - l <= cutoff || l mod 2 = 0 || cls.(int_of_float (!cur_x)).(l) = 0 then
cls.(int_of_float (!cur_x)).(l) <- origin+1
else
();
if y2 - l > cutoff then
mat.(int_of_float (!cur_x)).(l) <- '-'
else
mat.(int_of_float (!cur_x)).(l) <- '>'
end
else
()
done
else
for l = y1 downto y2 do
let cur_x = ref (float_of_int x2) in
if (!slope) <> 1.0 /. 0.0 && (!slope) <> (-. 1.) /. 0. then
cur_x := ((float_of_int l) +. ((!slope) *. (float_of_int x1) -. (float_of_int y1))) /. (!slope)
else
();
if is_rempaceable mat.(int_of_float (!cur_x)).(l) override_arr then begin
if l - y2 <= cutoff || l mod 2 = 0 || cls.(int_of_float (!cur_x)).(l) = 0 then
cls.(int_of_float (!cur_x)).(l) <- origin+1
else
();
if l - y2 > cutoff then
mat.(int_of_float (!cur_x)).(l) <- '-'
else
mat.(int_of_float (!cur_x)).(l) <- '<'
end
else
()
done;;
let display mat cls =
let colors = [|"\027[0m"; "\027[41m"; "\027[42m"; "\027[43m"; "\027[44m"; "\027[45m"; "\027[46m"; "\027[47m"; "\027[100m"; "\027[101m"; "\027[102m"; "\027[103m"; "\027[104m"; "\027[105m"; "\027[106m"; "\027[107m"|] in
for i = 0 to (Array.length mat -1) do
for j = 0 to (Array.length mat.(i) -1) do
if cls.(i).(j) = 0 then
print_string colors.(0)
else
print_string colors.(max 1 (cls.(i).(j) mod (Array.length colors)));
if mat.(i).(j) = '&' then
print_char ' '
else
print_char mat.(i).(j)
done;
print_string "\027[0m";
print_char '\n'
done;;
let display_specific mat cls digit =
let colors = [|"\027[0m"; "\027[41m"; "\027[42m"; "\027[43m"; "\027[44m"; "\027[45m"; "\027[46m"; "\027[47m"; "\027[100m"; "\027[101m"; "\027[102m"; "\027[103m"; "\027[104m"; "\027[105m"; "\027[106m"; "\027[107m"|] in
for i = 0 to (Array.length mat -1) do
for j = 0 to (Array.length mat.(i) -1) do
if cls.(i).(j) <> digit then
print_string colors.(0)
else
print_string colors.(max 1 (cls.(i).(j) mod (Array.length colors)));
if mat.(i).(j) = '&' then
print_char ' '
else
print_char mat.(i).(j)
done;
print_string "\027[0m";
print_char '\n'
done;;
let extend dgt mat cls i0 j0 dst =
let ni = Array.length mat in
let nj = Array.length mat.(0) in
cls.(i0).(j0) <- dgt + 1;
for i = -dst to dst do
for j = -dst to dst do
if i0 - i >= 0 && j0 - j >= 0 && i0 - i < ni && j0 - j < nj then begin
cls.(i0-i).(j0-j) <- dgt + 1;
if abs i = dst || abs j = dst then
mat.(i0-i).(j0-j) <- '*'
else if i <> 0 || j <> 0 then
mat.(i0-i).(j0-j) <- '&'
else
()
end
else
()
done
done ;;
let identity x = x ;;
let copy_arr src =
let dest = Array.make (Array.length src) [||] in
for i = 0 to (Array.length src -1) do
dest.(i) <- Array.make (Array.length src.(i)) src.(0).(0);
for j = 0 to (Array.length src.(i) -1) do
dest.(i).(j) <- src.(i).(j)
done
done;
dest ;;
let rec pw x n = match n with
| 0 -> 1
| 1 -> x
| k -> x * pw x (n-1) ;;
let to_hexa n =
let res = ref "" in
let remaining = ref n in
if n = 0 then
"0"
else begin
while !remaining > 0 do
let cd = ref (48 + !remaining mod 16) in
if !cd >= 58 then
cd := !cd + 7
else
();
res := ((String.make 1 (Char.chr !cd)) ^ !res);
remaining := !remaining / 16;
done;
!res ;
end;;
let extremely_fancy_graph_printing g size wmult mode =
(* creation of the image *)
let px = Array.make (size) [||] in
for i = 0 to (size-1) do
px.(i) <- Array.make (wmult*size) ' '
done;
(* color matrix *)
let cls = Array.make (size) [||] in
for i = 0 to (size-1) do
cls.(i) <- Array.make (wmult*size) 0
done;
if Array.length g >= 100 then
failwith "ERROR : graph is too big"
else
();
let coords = Array.make size (0, 0) in
(* placing the points on the trig circle *)
for k = 0 to Array.length g - 1 do
let theta = 2. *. pi *. (float_of_int k) /. (float_of_int (Array.length g)) +. pi /. (float_of_int (Array.length g)) in
let i = ref (int_of_float ((float_of_int size) /. 2.) + int_of_float ((float_of_int size) /. 2. *. cos theta)) in
let j = ref (int_of_float ((float_of_int size) /. 2.) + int_of_float ((float_of_int size) /. 2. *. sin theta)) in
if !i < 1 then i := 1 else ();
if !j < 1 then j := 1 else ();
if !i >= size-1 then i := size-1-1 else ();
if !j >= size-1 then j := size-1-1 else ();
px.(!i).(wmult* !j) <- '~';
extend k px cls !i (wmult* !j) 2;
let str_to_place = to_hexa k in
for sl = 0 to (String.length str_to_place -1) do
if !i + 1 < size && wmult* !j-sl-1 >= 0 && wmult* !j+sl-1 < Array.length px.(0) then
px.(!i + 1).(wmult* !j-sl-1) <- str_to_place.[sl]
else
()
done;
coords.(k) <- (!i, wmult* !j);
done;
let blankcls = copy_arr cls in
let bpx = copy_arr px in
(* draw the connections *)
for i = 0 to Array.length g -1 do
for j = 0 to Array.length g.(i) -1 do
draw_line_bresenham px cls i (fst coords.(i)) (snd coords.(i)) (fst coords.(g.(i).(j))) (snd coords.(g.(i).(j))) 0
done
done;
(* show the image *)
ignore (Sys.command "clear");
if mode = "SPECIFIC" then begin
let halt = ref false in
while !halt = false do
Stdlib.print_endline "Enter the node you want to highlight (type -1 to show all; -2 to exit; -3 to stream all)";
let nd = ref (-2) in
nd := Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity;
ignore (Sys.command "clear");
if !nd >= 0 && !nd < Array.length g then
display_specific px cls (!nd+1)
else if !nd = -1 then
display px cls
else if !nd = -2 then
halt := true
else if !nd = -3 then begin
for i = 0 to (Array.length g -1) do
ignore (Sys.command "clear");
display_specific px cls (i+1);
Stdlib.print_endline "_";
ignore (Sys.command "sleep 1");
done;
display px cls;
Stdlib.print_endline "_";
ignore (Sys.command "sleep 1");
end
else
()
done
end
else if mode <> "HIDE" then
display px cls;
(coords, px, bpx, cls, blankcls) ;;
(* coords = (x, y) coords of graph point *)
(* px = 2D matrix containing what to display *)
(* cls = colors of associated pixel *)
let fancy_dfs gr coords px bcls =
Stdlib.print_endline "Enter any integer to begin DFS : ";
ignore (Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity);
let n = Array.length gr in
let visited = Array.make n false in
visited.(0) <- true;
let rec explore nd =
if true then begin
for i = 0 to (Array.length gr.(nd) -1) do
draw_line_bresenham px bcls nd (fst coords.(nd)) (snd coords.(nd)) (fst coords.(gr.(nd).(i))) (snd coords.(gr.(nd).(i))) 4;
display px bcls;
Stdlib.print_endline "_";
ignore (Sys.command "sleep 1");
if visited.(gr.(nd).(i)) = false then begin
visited.(gr.(nd).(i)) <- true;
explore gr.(nd).(i);
end
done
end
else
()
in
explore 0;
display px bcls ;;
(* --------------------------------------| TESTS |-------------------------------------- *)
(*
let gr = [|[|3; 5; 7|]; [|0|]; [|1; 7; 8|]; [|2; 6|]; [|0; 1; 3|]; [|6; 7|]; [|0; 1; 2|]; [|8|]; [|0; 7; 6|]; [||]; [||]; [|9|]|] ;;
let (coords, map, blank_map, color_map, blank_color_map) = extremely_fancy_graph_printing gr 46 3 "SHOW" ;;
fancy_dfs gr coords map blank_color_map ;;
*)
(* --------------------------------------------------------------------------------------------------------- *)
(* --------------------------------------------------------------------------------------------------------- *)
(* --------------------------------------------------------------------------------------------------------- *)
(* --------------------------------------------------------------------------------------------------------- *)
open Graphics ;;
type 'a tree = Empty | Leaf of 'a | Node of 'a * 'a tree * 'a tree ;;
(*
STRUCT : (digit, xcoord, ycoord)
*)
let rec pw x n = match n with
| 0 -> 1
| 1 -> x
| k when k mod 2 = 0 -> let res = pw x (n/2) in res*res
| k -> let res = pw x (n/2) in res*res*x ;;
let rec depth_of_tree t = match t with
| Leaf _ -> 1
| Node (_, g, d) -> 1 + max (depth_of_tree g) (depth_of_tree d)
| Empty -> 0;;
let fill_data te ystep sx sy r =
let depth = depth_of_tree te in
let res = Array.make (depth+1) [] in
let rec aux t cur_x cur_d spacing pcx pcy = match t with
| Node (x, g, d) -> begin
aux g (cur_x - spacing) (cur_d+1) (spacing/2) cur_x (sy - r - 20 - ystep * cur_d);
res.(cur_d) <- (((x, (pcx, pcy)), (cur_x, sy - r - 20 - ystep * cur_d)))::(res.(cur_d));
aux d (cur_x + spacing) (cur_d+1) (spacing/2) cur_x (sy - r - 20 - ystep * cur_d);
end
| Leaf x -> begin
res.(cur_d) <- (((x, (pcx, pcy)), (cur_x, sy - r - ystep * cur_d)))::(res.(cur_d));
end
| Empty -> ()
in aux te (sx/2) 0 (r/2 + r * ((pw 2 (depth-1)) - 1)) (-1) (-1); res ;;
let rec ln10 n = match n with
| k when k < 0 -> failwith "Are you sure about that ?"
| k when k < 10 -> 0
| k -> 1 + ln10 (k/10) ;;
let delta i j =
if i = j then 1 else 0 ;;
let draw_integer x0 y n0 r =
(* 7-seg display *)
let n = ref n0 in
let size = ln10 n0 in
let len = r/3 in
let offset = size*(len/2) in
for i = 0 to size do
let x = x0 - (-(1 - delta size 0)*8 - offset + i * (len+8)) in
if Array.mem (!n mod 10) [|0; 4; 5; 6; 7; 8; 9|] then
draw_poly_line [|(x-len/2, y+len); (x-len/2, y)|];
if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 7; 8; 9|] then
draw_poly_line [|(x-len/2, y+len); (x+len/2, y+len)|];
if Array.mem (!n mod 10) [|0; 1; 2; 3; 4; 7; 8; 9|] then
draw_poly_line [|(x+len/2, y+len); (x+len/2, y)|];
if Array.mem (!n mod 10) [|2; 3; 4; 5; 6; 8; 9|] then
draw_poly_line [|(x-len/2, y); (x+len/2, y)|];
if Array.mem (!n mod 10) [|0; 1; 3; 4; 5; 6; 7; 8; 9|] then
draw_poly_line [|(x+len/2, y-len); (x+len/2, y)|];
if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 8; 9|] then
draw_poly_line [|(x-len/2, y-len); (x+len/2, y-len)|];
if Array.mem (!n mod 10) [|0; 2; 6; 8|] then
draw_poly_line [|(x-len/2, y-len); (x-len/2, y)|];
n := !n/10;
done ;;
let rec draw_list l d r = match l with
| [] -> ()
| h::t -> begin
set_color (rgb 192 192 192);
fill_circle (fst (snd h)) (snd (snd h)) r;
set_color black;
draw_circle (fst (snd h)) (snd (snd h)) r;
moveto (fst (snd h)) (snd (snd h));
set_color (rgb 32 192 32);
draw_integer (fst (snd h)) (snd (snd h)) (fst (fst h)) r;
draw_list t d r
end;;
let connect l0 =
let rec aux l = match l with
| [] -> ()
| ((_, (xf, yf)), (x, y))::t ->
if xf >= 0 && yf >= 0 then begin
set_color (rgb 192 192 192);
draw_poly_line [|(xf, yf); (x, y)|];
aux t
end
in aux l0 ;;
let even_more_pretty_printing t r ystep skip =
let sx = Graphics.size_x () in
let sy = Graphics.size_y () in
let graphdata = fill_data t ystep sx sy (6*r/10) in
(* graphdata is a ((int * (int * int)) * (int * int)) list array *)
(* <==> ((value, (parent_x, parent_y)), (this_x, this_y)) *)
if skip = false then begin
set_color (rgb 192 192 192);
set_line_width 15 ;
for dpth = 1 to (Array.length graphdata -1) do
connect graphdata.(dpth-1);
done;
set_line_width 5 ;
for dpth = 0 to (Array.length graphdata -1) do
draw_list graphdata.(dpth) dpth r
done;
let halt = ref false in
while !halt = false do
Unix.sleepf 0.1 ;
Unix.sleepf 2.0 ;
halt := true;
done;
end;
graphdata ;;
let generate_full_tree d =
let rec aux n = match n with
| 0 -> Leaf (Random.int 1000)
| k -> begin
Node (Random.int 1000, aux (n-1), aux (n-1))
end
in aux d ;;
let generate_some_tree maxd nodechance leafchance =
let rec aux n = match n with
| 0 -> if (Random.int 101 < leafchance) then Leaf (Random.int 100) else Empty
| k -> begin
match Random.int 101 with
| k when k <= nodechance -> Node (Random.int 1000, aux (n-1), aux (n-1))
| k -> if (Random.int 101 < leafchance) then Leaf (Random.int 1000) else Empty
end
in aux maxd ;;
let rec nth l n = match l with
| [] -> failwith "Out of range"
| h::t when n = 0 -> h
| h::t -> nth t (n-1) ;;
let even_more_fancy_dfs_prefixe t graphdata r tts rfound gfound bfound rmark gmark bmark =
let d = depth_of_tree t in
let count_per_depth = Array.make d 0 in
let rec aux tr dpth =
match tr with
| Empty -> ()
| Leaf _ -> begin
let data = nth graphdata.(dpth) (List.length graphdata.(dpth) - count_per_depth.(dpth) - 1) in
count_per_depth.(dpth) <- count_per_depth.(dpth) + 1;
set_color (rgb rfound gfound bfound);
draw_circle (fst (snd data)) (snd (snd data)) r;
Unix.sleepf tts;
set_color (rgb rmark gmark bmark);
draw_circle (fst (snd data)) (snd (snd data)) r;
end
| Node (_, g, d) -> begin
let data = nth graphdata.(dpth) (List.length graphdata.(dpth) - count_per_depth.(dpth) - 1) in
count_per_depth.(dpth) <- count_per_depth.(dpth) + 1;
set_color (rgb rfound gfound bfound);
draw_circle (fst (snd data)) (snd (snd data)) r;
Unix.sleepf tts;
set_color (rgb rmark gmark bmark);
draw_circle (fst (snd data)) (snd (snd data)) r;
aux g (dpth+1);
aux d (dpth+1);
end
in aux t 0 ;;
let even_more_fancy_dfs_infixe t graphdata r tts rfound gfound bfound rmark gmark bmark =
let rec aux tr dpth os =
match tr with
| Empty -> ()
| Leaf _ -> begin
let data = nth graphdata.(dpth) (List.length graphdata.(dpth) - os - 1) in
set_color (rgb rfound gfound bfound);
draw_circle (fst (snd data)) (snd (snd data)) r;
Unix.sleepf tts;
set_color (rgb rmark gmark bmark);
draw_circle (fst (snd data)) (snd (snd data)) r;
end
| Node (_, g, d) -> begin
aux g (dpth+1) (2*os);
let data = nth graphdata.(dpth) (List.length graphdata.(dpth) - os - 1) in
set_color (rgb rfound gfound bfound);
draw_circle (fst (snd data)) (snd (snd data)) r;
Unix.sleepf tts;
set_color (rgb rmark gmark bmark);
draw_circle (fst (snd data)) (snd (snd data)) r;
aux d (dpth+1) (2*os + 1);
end
in aux t 0 0 ;;
let even_more_fancy_dfs_postfixe t graphdata r tts rfound gfound bfound rmark gmark bmark =
let rec aux tr dpth os =
match tr with
| Empty -> ()
| Leaf _ -> begin
let data = nth graphdata.(dpth) (List.length graphdata.(dpth) - os - 1) in
set_color (rgb rfound gfound bfound);
draw_circle (fst (snd data)) (snd (snd data)) r;
Unix.sleepf tts;
set_color (rgb rmark gmark bmark);
draw_circle (fst (snd data)) (snd (snd data)) r;
end
| Node (_, g, d) -> begin
aux g (dpth+1) (2*os);
aux d (dpth+1) (2*os + 1);
let data = nth graphdata.(dpth) (List.length graphdata.(dpth) - os - 1) in
set_color (rgb rfound gfound bfound);
draw_circle (fst (snd data)) (snd (snd data)) r;
Unix.sleepf tts;
set_color (rgb rmark gmark bmark);
draw_circle (fst (snd data)) (snd (snd data)) r;
end
in aux t 0 0 ;;
(* --------------------------------------| TESTS |-------------------------------------- *)
Random.self_init ;;
open_graph " 1800x800" ;;
set_window_title "Trees" ;;
let tt = generate_some_tree 4 100 75 ;;
let gdata = even_more_pretty_printing tt 40 150 false ;;
even_more_fancy_dfs_prefixe tt gdata 40 0.2 255 255 32 32 32 255 ;;
close_graph () ;;
(* compilation command : ocamlfind ocamlc -linkpkg -package unix -linkpkg -package graphics pretty_printing.ml *)
print_int 0 ;;
print_char '\n' ;;