blob: 7693f699e4f7fdd1f75466b0dd2a185eb51eb4cf (
plain) (
blame)
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
|
(* Generic binary heaps. *)
module Heap: sig
type 'a t
val create: ('a -> 'a -> int) -> 'a t
val add: 'a t -> 'a -> unit
val pop: 'a t -> 'a option
val top: 'a t -> 'a option
end = struct
type 'a t =
{ mutable arr: 'a array
; mutable len: int
; cmp: 'a -> 'a -> int
}
let mkarray n = Array.make n (Obj.magic 0)
let create cmp = {arr = mkarray 2; len = 0; cmp }
let top {arr; len; _} =
if len = 0 then None else Some arr.(1)
let swap arr i j =
let tmp = arr.(i) in
arr.(i) <- arr.(j);
arr.(j) <- tmp
let rec bblup cmp arr i =
let prnt = i/2 in
if prnt = 0 then () else
if cmp arr.(prnt) arr.(i) < 0 then () else
(swap arr prnt i; bblup cmp arr prnt)
let add ({arr; len; cmp} as hp) x =
let arr =
let alen = Array.length arr in
if alen > len+1 then arr else
let arr' = mkarray (alen * 2) in
Array.blit arr 0 arr' 0 alen;
hp.arr <- arr';
arr' in
hp.len <- len + 1;
arr.(hp.len) <- x;
bblup cmp arr hp.len
let rec bbldn cmp arr i len =
let ch0 = 2*i in
let ch1 = ch0 + 1 in
if ch0 > len then () else
let mn =
if ch1 > len then ch0 else
if cmp arr.(ch0) arr.(ch1) < 0
then ch0 else ch1 in
if cmp arr.(i) arr.(mn) <= 0 then () else
(swap arr i mn; bbldn cmp arr mn len)
let pop ({arr; len; cmp} as hp) =
if len = 0 then None else
let t = top hp in
arr.(1) <- arr.(len);
hp.len <- len - 1;
bbldn cmp arr 1 len;
t
end
let rec popall h =
match Heap.pop h with
| None -> []
| Some x -> x :: popall h
let _ =
if true then
let rnd () =
(2047 land Random.bits ()) *
((Random.bits () land 2) - 1) in
let rec f n = if n = 0 then [] else rnd () :: f (n-1) in
for n = 1 to 150 do
for i = 1 to 1_000 do
let l = f n in
(* List.iter (Printf.printf "%d, ") l; print_newline (); *)
let h = Heap.create compare in
List.iter (Heap.add h) l;
let l' = popall h in
assert (List.sort compare l = l');
done;
Printf.printf "... %d\n" n;
flush stdout;
done;
print_string "OK!\n"
|
