Commit 2c481a82 authored by charguer's avatar charguer
Browse files

mutablepairing

parent 873dcea1
module Stack = struct
type 'a t = 'a list ref
let create () =
ref []
let is_empty s =
!s = []
let push x s =
s := x::!s
let pop s =
match !s with
| [] -> raise Not_found
| x::t -> s := t; x
end
type elem = int
type node = { value : elem; sub : node Stack.t }
type contents = Empty | Nonempty of node
type heap = contents ref
let create () =
ref Empty
let is_empty p =
!p = Empty
let merge q1 q2 =
if q1.value < q2.value
then (Stack.push q2 q1.sub ; q1)
else (Stack.push q1 q2.sub ; q2)
let insert p x =
let q2 = { value = x; sub = Stack.create() } in
match !p with
| Empty -> p := Nonempty q2
| Nonempty q1 -> p := Nonempty (merge q1 q2)
let rec merge_pairs l =
let q1 = Stack.pop l in
if Stack.is_empty l then q1 else
let q2 = Stack.pop l in
let q = merge q1 q2 in
if Stack.is_empty l
then q
else merge q (merge_pairs l)
let pop_min p =
match !p with
| Empty -> raise Not_found
| Nonempty q ->
let x = q.value in
if Stack.is_empty q.sub
then p := Empty
else p := Nonempty (merge_pairs q.sub);
x
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment