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
|
(* The Computer Language Benchmarks Game
* http://shootout.alioth.debian.org/
*
* Contributed by Troestler Christophe
* Modified by Fabrice Le Fessant
*)
type 'a tree =
| Empty
| Node of 'a tree * 'a * 'a tree
let rec make i d =
(* if d = 0 then Empty *)
if d = 0
then Node (Empty, i, Empty)
else
let i2 = 2 * i and d = d - 1 in
Node (make (i2 - 1) d, i, make i2 d)
let rec check = function
| Empty -> 0
| Node (l, i, r) -> i + check l - check r
let min_depth = 4
let max_depth =
let n = try int_of_string Sys.argv.(1) with _ -> 10 in
max (min_depth + 2) n
let stretch_depth = max_depth + 1
let () =
(* Gc.set { (Gc.get()) with Gc.minor_heap_size = 1024 * 1024; max_overhead = -1; }; *)
let _c = check (make 0 stretch_depth) in
( (*
Printf.printf "stretch tree of depth %i\t check: %i\n" stretch_depth c
*) )
let long_lived_tree = make 0 max_depth
let loop_depths d =
for i = 0 to ((max_depth - d) / 2) + 1 - 1 do
let d = d + (i * 2) in
let niter = 1 lsl (max_depth - d + min_depth) in
let c = ref 0 in
for i = 1 to niter do
c := !c + check (make i d) + check (make (-i) d)
done;
( (*
Printf.printf "%i\t trees of depth %i\t check: %i\n" (2 * niter) d !c;
*) )
done
let () =
(*
flush stdout;
*)
loop_depths min_depth;
( (*
Printf.printf "long lived tree of depth %i\t check: %i\n"
max_depth (check long_lived_tree)
*) )
|
