Kennedy and Reingold-Tillford algorithms for tree node positioning
1open Tree
2open Render
3
4let leaf x = Node (x, [])
5let node x children = Node (x, children)
6
7let example_tree =
8 node "A" [
9 node "B" [
10 node "D" [
11 leaf "H";
12 leaf "I"
13 ];
14 leaf "E"
15 ];
16 node "C" [
17 node "F" [
18 leaf "J";
19 node "K" [
20 leaf "N";
21 leaf "O";
22 leaf "P"
23 ];
24 leaf "L"
25 ];
26 leaf "G"
27 ]
28 ]
29
30let nested =
31 node "root" [
32 node "left" [
33 node "ll" [
34 leaf "lll";
35 leaf "llr"
36 ];
37 node "lr" [
38 leaf "lrl";
39 leaf "lrr"
40 ]
41 ];
42 node "middle" [
43 leaf "ml";
44 leaf "mm";
45 leaf "mr"
46 ];
47 node "right" [
48 node "rl" [
49 node "rll" [
50 leaf "rlll";
51 leaf "rllr";
52 leaf "rllm"
53 ];
54 leaf "rlr"
55 ];
56 leaf "rr"
57 ]
58 ]
59
60let () =
61 let positioned, _ = design example_tree in
62 let absolute = absolutize 0.0 positioned in
63 let nodes = flatten absolute in
64 let tree_edges = edges absolute in
65
66 render_tree
67 ~filename:"tree_kennedy.png"
68 ~node_radius:20
69 ~h_scale:70.0
70 ~v_scale:100
71 ~padding:50
72 nodes
73 tree_edges;
74
75 let absolute_rt = design_rt example_tree in
76 let nodes_rt = flatten absolute_rt in
77 let edges_rt = edges absolute_rt in
78
79 render_tree
80 ~filename:"tree_rt.png"
81 ~node_radius:20
82 ~h_scale:70.0
83 ~v_scale:100
84 ~padding:50
85 nodes_rt
86 edges_rt;
87
88 let positioned2, _ = design nested in
89 let absolute2 = absolutize 0.0 positioned2 in
90 let nodes2 = flatten absolute2 in
91 let edges2 = edges absolute2 in
92
93 render_tree
94 ~filename:"nested_kennedy.png"
95 ~node_radius:18
96 ~h_scale:60.0
97 ~v_scale:90
98 ~padding:45
99 nodes2
100 edges2;
101
102 let absolute2_rt = design_rt nested in
103 let nodes2_rt = flatten absolute2_rt in
104 let edges2_rt = edges absolute2_rt in
105
106 render_tree
107 ~filename:"nested_rt.png"
108 ~node_radius:18
109 ~h_scale:60.0
110 ~v_scale:90
111 ~padding:45
112 nodes2_rt
113 edges2_rt