simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2026-01-29 04:14:51 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

use skew heap in Gen

Browse source
This commit is contained in:
Simon Cruanes 2013-11-11 20:33:17 +01:00
parent 38257ddc50
commit e36fc5275a
1 changed files with 14 additions and 49 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

63
gen.ml
View file

@ -456,11 +456,10 @@ module Heap = struct
type 'a t = { type 'a t = {
mutable tree : 'a tree; mutable tree : 'a tree;
cmp : 'a -> 'a -> int; cmp : 'a -> 'a -> int;
} (** A splay tree heap with the given comparison function *) } (** A pairing tree heap with the given comparison function *)
and 'a tree = and 'a tree =
| Empty | Empty
| Node of ('a tree * 'a * 'a tree) | Node of 'a * 'a tree * 'a tree
(** A splay tree containing values of type 'a *)
let empty ~cmp = { let empty ~cmp = {
tree = Empty; tree = Empty;
@ -472,56 +471,22 @@ module Heap = struct
| Empty -> true | Empty -> true
| Node _ -> false | Node _ -> false
(** Partition the tree into (elements <= pivot, elements > pivot) *) let rec union ~cmp t1 t2 = match t1, t2 with
let rec partition ~cmp pivot tree = | Empty, _ -> t2
match tree with | _, Empty -> t1
| Empty -> Empty, Empty | Node (x1, l1, r1), Node (x2, l2, r2) ->
| Node (a, x, b) -> if cmp x1 x2 <= 0
if cmp x pivot <= 0 then Node (x1, union ~cmp t2 r1, l1)
then begin else Node (x2, union ~cmp t1 r2, l2)
match b with
| Empty -> (tree, Empty)
| Node (b1, y, b2) ->
if cmp y pivot <= 0
then
let small, big = partition ~cmp pivot b2 in
Node (Node (a, x, b1), y, small), big
else
let small, big = partition ~cmp pivot b1 in
Node (a, x, small), Node (big, y, b2)
end else begin
match a with
| Empty -> (Empty, tree)
| Node (a1, y, a2) ->
if cmp y pivot <= 0
then
let small, big = partition ~cmp pivot a2 in
Node (a1, y, small), Node (big, x, b)
else
let small, big = partition ~cmp pivot a1 in
small, Node (big, y, Node (a2, x, b))
end
(** Insert the element in the tree *)
let insert h x = let insert h x =
let small, big = partition ~cmp:h.cmp x h.tree in h.tree <- union ~cmp:h.cmp (Node (x, Empty, Empty)) h.tree
let tree' = Node (small, x, big) in
h.tree <- tree'
(** Get minimum value and remove it from the tree *) let pop h = match h.tree with
let pop h =
let rec delete_min tree = match tree with
| Empty -> raise Not_found | Empty -> raise Not_found
| Node (Empty, x, b) -> x, b | Node (x, l, r) ->
| Node (Node (Empty, x, b), y, c) -> h.tree <- union ~cmp:h.cmp l r;
x, Node (b, y, c) (* rebalance *) x
| Node (Node (a, x, b), y, c) ->
let m, a' = delete_min a in
m, Node (a', x, Node (b, y, c))
in
let m, tree' = delete_min h.tree in
h.tree <- tree';
m
end end
(** Intersection of two sorted sequences. Only elements that occur in both (** Intersection of two sorted sequences. Only elements that occur in both