(* * * * * * * * * * * * LEFT TREES * * * * * * * * * * * *) type priority = int type 'a queue = | Empty | Node of priority * 'a * 'a queue * 'a queue * int (* priority, left son, right son, interval to the nearest leaf (the most right one) *) let empty() = Empty let is_empty = function Empty -> true | _ -> false let interval = function Empty -> 0 | Node (_,_,_,_,i) -> i exception Unproper_use_of_queue let rec insert queue prio elt = match queue with | Empty -> Node(prio, elt, Empty, Empty, 1) | Node(p, e, left, right, _) -> if prio <= p then let new_right = insert right p e in match left, new_right with | Node (_,_,_,_, i), Node (_,_,_,_, j) -> if i > j then Node(prio, elt, left, new_right, j + 1) else Node (prio, elt, new_right, left, i + 1) | Empty, _ -> Node (prio, elt, new_right, left, 1) | _, Empty -> raise Unproper_use_of_queue else let new_right = insert right prio elt in match left, new_right with | Node (_,_,_,_, i), Node (_,_,_,_, j) -> if i > j then Node(p, e, left, new_right, j + 1) else Node (p, e, new_right, left, i + 1) | Empty, _ -> Node (p, e, new_right, left, 1) | _, Empty -> raise Unproper_use_of_queue exception Queue_is_empty let rec union q1 q2 = match q1, q2 with | Empty, _ -> q2 | _, Empty -> q1 | Node(p1, e1, ql1, qr1, i1), Node (p2, e2, ql2, qr2, i2) -> if p1 > p2 then let new_left = q1 in let new_i1 = interval new_left and new_right = union qr2 ql2 in let new_i2 = interval new_right in if new_i1 < new_i2 then (* watch it - rotation *) Node (p2, e2, new_left, new_right, i1) else Node (p2, e2, new_right, new_left, i2) else let new_left = q2 in let new_i1 = interval new_left and new_right = union ql1 qr1 in let new_i2 = interval new_right in if new_i1 < new_i2 then (* watch it - rotation *) Node (p1, e1, new_left, new_right, i1) else Node (p1, e1, new_right, new_left, i2) let rec remove_top = function Empty -> raise Queue_is_empty | Node (_, _,q1, q2, _) -> union q1 q2 let delete_min = function Empty -> raise Queue_is_empty | Node(prio, elt, _, _, _) as queue -> (prio, elt, remove_top queue) let find_min = function Empty -> raise Queue_is_empty | Node(prio, elt, _, _, _) as queue -> (prio, elt, queue)