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
|
type step = [ `Left | `Right ]
and heap_pointer = step list
and heap_skeleton = heap_pointer * heap_pointer * heap_pointer
type productive_step = [ `On_left of step | `On_right of step ]
and non_empty_skeleton = productive_step * heap_skeleton
let normalize_skeleton = function
| `On_left s, (l, i, r) -> (s::l, i, r)
| `On_right s, (l, i, r) -> (l, i, s::r)
let productive_skeleton = function
| (s::l, i, r) -> `On_left s, (l, i, r)
| (l, i, s::r) -> `On_right s, (l, i, r)
| ([], _i, []) -> failwith "productive_skeleton"
let fill_skeleton h (l, i, r) =
let get = function
| None -> failwith "skeleton points too far"
| Some h -> h in
let follow =
let step h =
let h = get h in function
| `Left -> h.left
| `Right -> h.right in
List.fold_left step in
{left = follow h l;
item = (get (follow h i)).item;
right = follow h r}
let rec digamma f h =
match h with
| {left=None; right=t} | {left=t; right=None} ->
t
| {left=Some l; right=Some r} ->
let recur (skel : non_empty_skeleton) =
digamma f (fill_skeleton (Some h) (normalize_skeleton skel)) in
f recur l h.item r
let heap_remove_max h =
let f k l _i r =
if l.item > r.item then
Some{l with right = k (`On_left `Left, ([`Right], [], [`Right]))}
else
Some{r with left = k (`On_right `Right, ([`Left], [], [`Left]))}
in digamma f h |
Partager