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
141
142
143
type t = {
min: int ;
max: int ;
mutable expand: int ;
mutable current: int;
mutable fixed: bool;
}
module type Elt = sig
type t
val to_string : t -> string
module Map : Map.S with type key = t
end
module Make (E:Elt) = struct
let init get_min get_max get_expand children =
List.fold_left
(fun (parts, acc) elt ->
let t =
let expand = max 0 (get_expand elt) in
let min = get_min elt in
let max = match get_max elt with None -> max_int | Some n -> n in
{
min ; max ; expand ;
current = 0 ; fixed = false ;
}
in
(parts + t.expand, E.Map.add elt t acc)
)
(0, E.Map.empty) children
let fix elt t =
[%debug "Pack.Packer: fix %s at %d"
(E.to_string elt) t.current];
t.fixed <- true
let shrink_or_expand ~parts ~remain m =
let space_by_part = if parts = 0 then 0 else remain / parts in
let = ref
(if parts = 0 then 0 else ((abs remain) mod parts))
in
let bound t = if remain >= 0 then t.max else t.min in
let (incr_current, decr_remain) =
if remain >= 0
then ((+), (-))
else ((-), (+))
in
E.Map.fold (fun elt t (all_fixed, remainparts, remain) ->
if t.fixed then
(all_fixed, remainparts, remain)
else
(
let diff = space_by_part * t.expand in
let c = max t.min (min t.max (t.current + diff)) in
let remain = remain - c + t.current in
t.current <- c ;
if t.current = bound t then
(
fix elt t ;
(all_fixed, remainparts, remain)
)
else
(
if space_by_part = 0 && !extra_space <> 0 then
(
t.current <- incr_current t.current 1;
decr extra_space ;
let remain = decr_remain remain 1 in
if t.current = bound t then
( fix elt t ;
(all_fixed, remainparts, remain)
)
else
(false, remainparts + t.expand, remain)
)
else
(false, remainparts + t.expand, remain)
)
)
)
m (true, 0, remain)
let debug_m m =
E.Map.iter
(fun elt t ->
[%debug "%s: min=%d, max=%d, expand=%d, current=%d, fixed=%b"
(E.to_string elt)
t.min t.max t.expand t.current t.fixed]
) m
let compute_remain avail m = E.Map.fold
(fun _oid t (all_fixed, parts, remain) ->
let remain = remain - t.current in
if t.fixed then
(all_fixed, parts, remain)
else
(false, parts + t.expand, remain)
) m (true, 0, avail)
let compute avail get_min get_max get_expand (children : E.t list) =
let (parts, m) = init get_min get_max get_expand children in
let (all_fixed, parts, remain) = compute_remain avail m in
let rec iter loops all_fixed parts remain =
[%debug "Pack.Packer.compute: parts=%d, remain=%d" parts remain];
debug_m m;
if loops <= 0 || remain = 0 || (parts = 0 && all_fixed) then
m
else
let (all_fixed, parts, remain) = shrink_or_expand ~parts ~remain m in
iter (loops - 1) all_fixed parts remain
in
iter (max 5 (List.length children)) all_fixed parts remain
end