1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
open Common
let _threshold = 0.00001
let _equal_float f1 f2 = abs_float (f1 -. f2) < _threshold
let _equal_pos p1 p2 = _equal_float p1.x p2.x && _equal_float p1.y p2.y
module Squarify = struct
type dir = Horizontal | Vertical
let length dir rect = match dir with
| Horizontal -> rect.w
| Vertical -> rect.h
let opp = function Horizontal -> Vertical | Vertical -> Horizontal
type 'a state = {
rect : rectangle ;
dir : dir ;
elements : 'a list ;
area : float ;
smallest : float ;
biggest : float ;
}
let add ~area sol x =
let a = area x in {
sol with
elements = x :: sol.elements ;
area = a +. sol.area ;
smallest = min a sol.area ;
biggest = max a sol.area ;
}
let init rect dir = {
rect ; dir ;
elements = [] ;
area = 0. ;
smallest = max_float ;
biggest = min_float ;
}
(** Return the worst aspect ratio *)
let worst sol =
let s = sol.area and w = length sol.dir sol.rect
and rp = sol.biggest and rm = sol.smallest in
max ((w*.w*.rp)/.(s*.s)) ((s*.s)/.(w*.w*.rm))
(** Utility functions for computing layout *)
let mv_pos dir { x ; y } len = match dir with
| Horizontal -> { y ; x = x +. len }
| Vertical -> { x ; y = y +. len }
let mk_rect dir side p len = match dir with
| Horizontal -> { p ; w = len ; h = side }
| Vertical -> { p ; h = len ; w = side }
let cut_rect dir { p ; w ; h } side =
let p = mv_pos dir p side in
match dir with
| Horizontal -> { p ; h ; w = w -. side }
| Vertical -> { p ; w ; h = h -. side }
(** Layout a solution in a given rectangle.
Iterate on the list of laid out elements (by continuation [k])
and return the new state. *)
let layout ~area sol k =
match sol.elements with
| [] -> sol
| _ -> begin
let total_len = length sol.dir sol.rect in
let side = sol.area /. total_len in
let new_rect = cut_rect (opp sol.dir) sol.rect side in
let layout_elem pos elem =
let len = total_len *. area elem /. sol.area in
let rect = mk_rect sol.dir side pos len in
let pos = mv_pos sol.dir pos len in
k (elem, rect);
pos
in
let _pos = List.fold_left layout_elem sol.rect.p sol.elements in
init new_rect (opp sol.dir)
end
let squarify ~area rect l : _ Iter.t =
let rec place_rect k state elem =
let updated = add ~area state elem in
if worst state >= worst updated then
updated
else
let state = layout ~area state k in
place_rect k state elem
in
let dir0 = if rect.w > rect.h then Horizontal else Vertical in
let state0 = init rect dir0 in
fun k ->
let state_final = Iter.fold (place_rect k) state0 l in
let _s = layout ~area state_final k in
assert (_s.rect.w *. _s.rect.h >= -. _threshold);
()
end
let squarify = Squarify.squarify
let layout ~area ~children rect0 t0 : _ Iter.t =
let rec go_level k (v, rect) =
k (v, rect) ;
let cl = children v in
let l = squarify ~area rect cl in
Iter.iter (go_level k) l
in
let area_rect = rect0.w *. rect0.h in
if area t0 <= area_rect +. _threshold then
fun k -> go_level k (t0, rect0)
else
invalid_arg @@
Format.sprintf
"Tree_layout.Squarify: \
This rectangle has area %.30g, \
it can not contain a tree of area %.30g."
area_rect
(area t0)