Reworked tree display

trees.ml

@@ -40,14 +40,15 @@ let rec ln10 n = match n with
 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
+  let offset = size*(len*11/7)/2 in
   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
           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 rec aux n = match n with
     | 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 
         match Random.int 101 with
         | 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
     in aux t 0 0 ;;
 
-(* --------------------------------------| TESTS |-------------------------------------- *)
-Random.self_init ;;
+(* NEW VERSION *)
 
-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" ;;
 
-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 () ;;