Reworked tree display
This commit is contained in:
parent
e0e60c8f3e
commit
1f6b2f7be5
127
trees.ml
127
trees.ml
|
@ -40,14 +40,15 @@ let rec ln10 n = match n with
|
||||||
let delta i j =
|
let delta i j =
|
||||||
if i = j then 1 else 0 ;;
|
if i = j then 1 else 0 ;;
|
||||||
|
|
||||||
|
|
||||||
let draw_integer x0 y n0 r =
|
let draw_integer x0 y n0 r =
|
||||||
(* 7-seg display *)
|
(* 7-seg display *)
|
||||||
let n = ref n0 in
|
let n = ref n0 in
|
||||||
let size = ln10 n0 in
|
let size = ln10 n0 in
|
||||||
let len = r/3 in
|
let len = r/3 in
|
||||||
let offset = size*(len/2) in
|
let offset = size*(len*11/7)/2 in
|
||||||
for i = 0 to size do
|
for i = 0 to size do
|
||||||
let x = x0 - (-(1 - delta size 0)*8 - offset + i * (len+8)) in
|
let x = x0 + offset - i*(len*11/7) in
|
||||||
if Array.mem (!n mod 10) [|0; 4; 5; 6; 7; 8; 9|] then
|
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)|];
|
draw_poly_line [|(x-len/2, y+len); (x-len/2, y)|];
|
||||||
|
|
||||||
|
@ -137,6 +138,7 @@ let generate_full_tree d =
|
||||||
let generate_some_tree maxd nodechance leafchance =
|
let generate_some_tree maxd nodechance leafchance =
|
||||||
let rec aux n = match n with
|
let rec aux n = match n with
|
||||||
| 0 -> if (Random.int 101 < leafchance) then Leaf (Random.int 100) else Empty
|
| 0 -> if (Random.int 101 < leafchance) then Leaf (Random.int 100) else Empty
|
||||||
|
| k when k = maxd -> Node (Random.int 1000, aux (maxd-1), aux (maxd-1))
|
||||||
| k -> begin
|
| k -> begin
|
||||||
match Random.int 101 with
|
match Random.int 101 with
|
||||||
| k when k <= nodechance -> Node (Random.int 1000, aux (n-1), aux (n-1))
|
| k when k <= nodechance -> Node (Random.int 1000, aux (n-1), aux (n-1))
|
||||||
|
@ -231,17 +233,126 @@ let even_more_fancy_dfs_postfixe t graphdata r tts rfound gfound bfound rmark gm
|
||||||
end
|
end
|
||||||
in aux t 0 0 ;;
|
in aux t 0 0 ;;
|
||||||
|
|
||||||
(* --------------------------------------| TESTS |-------------------------------------- *)
|
(* NEW VERSION *)
|
||||||
Random.self_init ;;
|
|
||||||
|
|
||||||
open_graph " 1800x800" ;;
|
type pt = {x : int ; y :int} ;;
|
||||||
|
type node_data = {tag : int ; parent : pt ; self : pt} ;;
|
||||||
|
|
||||||
|
type 'a data_tree = Nothing | Tail of node_data | Cross of node_data * 'a data_tree * 'a data_tree ;;
|
||||||
|
(* changing names to avoid confusion *)
|
||||||
|
|
||||||
|
let count_per_floor tr =
|
||||||
|
let d = depth_of_tree tr in
|
||||||
|
let res = Array.make d 0 in
|
||||||
|
let rec aux tr dpth = match tr with
|
||||||
|
| Empty -> ()
|
||||||
|
| Leaf _ -> res.(dpth) <- res.(dpth) + 1
|
||||||
|
| Node (_, g, d) -> res.(dpth) <- res.(dpth) + 1 ; aux g (dpth+1) ; aux d (dpth+1)
|
||||||
|
in aux tr 0 ; res ;;
|
||||||
|
|
||||||
|
let showtree tdt r =
|
||||||
|
let rec aux t = match t with
|
||||||
|
| Nothing -> ()
|
||||||
|
| Tail data -> begin
|
||||||
|
set_line_width 9;
|
||||||
|
set_color (rgb 48 48 48);
|
||||||
|
draw_poly_line [|(data.parent.x, data.parent.y); (data.self.x, data.self.y)|];
|
||||||
|
|
||||||
|
set_color (rgb 192 192 192);
|
||||||
|
fill_circle data.self.x data.self.y r;
|
||||||
|
|
||||||
|
set_color (rgb 32 192 32);
|
||||||
|
set_line_width 7;
|
||||||
|
draw_circle data.self.x data.self.y r;
|
||||||
|
|
||||||
|
set_color black;
|
||||||
|
set_line_width 5;
|
||||||
|
draw_integer data.self.x data.self.y data.tag r;
|
||||||
|
end
|
||||||
|
| Cross (data, g, d) -> begin
|
||||||
|
set_line_width 9;
|
||||||
|
set_color (rgb 48 48 48);
|
||||||
|
draw_poly_line [|(data.parent.x, data.parent.y); (data.self.x, data.self.y)|];
|
||||||
|
|
||||||
|
aux g;
|
||||||
|
aux d;
|
||||||
|
|
||||||
|
set_color (rgb 192 192 192);
|
||||||
|
fill_circle data.self.x data.self.y r;
|
||||||
|
|
||||||
|
set_color (rgb 192 192 32);
|
||||||
|
set_line_width 7;
|
||||||
|
draw_circle data.self.x data.self.y r;
|
||||||
|
|
||||||
|
set_color black;
|
||||||
|
set_line_width 5;
|
||||||
|
draw_integer data.self.x data.self.y data.tag r;
|
||||||
|
end
|
||||||
|
in aux tdt ;;
|
||||||
|
|
||||||
|
let coords_on_segment a b divsize k =
|
||||||
|
if divsize <> 0 then
|
||||||
|
a + k*(b-a)/divsize
|
||||||
|
else (a + b)/2 ;;
|
||||||
|
|
||||||
|
let max_of_arr a =
|
||||||
|
let m = ref a.(0) in
|
||||||
|
for i = 1 to (Array.length a -1) do
|
||||||
|
if !m < a.(i) then m := a.(i)
|
||||||
|
done; !m ;;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
let pretty_tree_printing_new_version tr r ystep win_w win_h display =
|
||||||
|
let d = depth_of_tree tr in
|
||||||
|
let amt_per_floor = count_per_floor tr in
|
||||||
|
|
||||||
|
let visited_fl = Array.make d 0 in
|
||||||
|
(* visited.(x) count the number of already visited nodes in floor x *)
|
||||||
|
|
||||||
|
let rec build_data_tree tr dpth parent_xy =
|
||||||
|
match tr with
|
||||||
|
| Empty -> Nothing
|
||||||
|
| Leaf x -> begin
|
||||||
|
(*let self = {x = win_w/2 - (14*r/6)*amt_per_floor.(dpth)/2 + (14*r/6)*visited_fl.(dpth); y = win_h - r/2 - (dpth)*ystep} in*)
|
||||||
|
let self = {x = coords_on_segment (max r (win_w/2 - 2*r*(pw 2 dpth))) (min (win_w - r) (win_w/2 + 2*r*(pw 2 dpth))) (amt_per_floor.(dpth)-1) visited_fl.(dpth); y = win_h - r/2 - (dpth)*ystep} in
|
||||||
|
visited_fl.(dpth) <- visited_fl.(dpth) + 1;
|
||||||
|
let data = {tag = x ; parent = parent_xy ; self = self} in
|
||||||
|
Tail (data)
|
||||||
|
end
|
||||||
|
| Node (x, g, d) -> begin
|
||||||
|
(*let self = {x = win_w/2 - (14*r/6)*amt_per_floor.(dpth)/2 + (14*r/6)*visited_fl.(dpth); y = win_h - r/2 - (dpth)*ystep} in*)
|
||||||
|
let self = {x = coords_on_segment (max r (win_w/2 - 2*r*(pw 2 dpth))) (min (win_w - r) (win_w/2 + 2*r*(pw 2 dpth))) (amt_per_floor.(dpth)-1) visited_fl.(dpth); y = win_h - r/2 - (dpth)*ystep} in
|
||||||
|
visited_fl.(dpth) <- visited_fl.(dpth) + 1;
|
||||||
|
if dpth <> 0 then begin
|
||||||
|
let data = {tag = x ; parent = parent_xy ; self = self} in
|
||||||
|
Cross (data, build_data_tree g (dpth+1) self, build_data_tree d (dpth+1) self)
|
||||||
|
end else begin
|
||||||
|
let data = {tag = x ; parent = self ; self = self} in
|
||||||
|
Cross (data, build_data_tree g (dpth+1) self, build_data_tree d (dpth+1) self)
|
||||||
|
end
|
||||||
|
end
|
||||||
|
in
|
||||||
|
let treedata = build_data_tree tr 0 {x = win_w/2 ; y = win_h - r} in
|
||||||
|
if display then showtree treedata r ;;
|
||||||
|
|
||||||
|
(* --------------------------------------| TESTS |-------------------------------------- *)
|
||||||
|
Random.self_init () ;;
|
||||||
|
|
||||||
|
let identity n = n ;;
|
||||||
|
|
||||||
|
open_graph " 1800x1000" ;;
|
||||||
set_window_title "Trees" ;;
|
set_window_title "Trees" ;;
|
||||||
|
|
||||||
let tt = generate_some_tree 4 100 75 ;;
|
let tt = generate_some_tree 5 75 100 ;;
|
||||||
|
|
||||||
let gdata = even_more_pretty_printing tt 40 150 false ;;
|
ignore (pretty_tree_printing_new_version tt 40 150 1800 1000 true) ;;
|
||||||
|
|
||||||
even_more_fancy_dfs_prefixe tt gdata 40 0.2 255 255 32 32 32 255 ;;
|
ignore (Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity) ;;
|
||||||
|
(*
|
||||||
|
let gdata = even_more_pretty_printing tt 30 150 false ;;
|
||||||
|
|
||||||
|
even_more_fancy_dfs_prefixe tt gdata 30 0.2 255 255 32 32 32 255 ;;*)
|
||||||
|
|
||||||
close_graph () ;;
|
close_graph () ;;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue