From Okasaky, "Pure Functional Data Structures"
Chapter 3: Leftist Heaps

> module Leftist_Heaps where

A "heap", or "priority queue", is a data structure containing a set
of values from an ordered type.
It has functions to insert a new value into it, to read the minimum
value contained in it and to delete that value.

The Heap class is an abstract definition of priority queues.

> class Heap h where
>   empty     :: Ord a => h a
>   isEmpty   :: Ord a => h a -> Bool
>   insert    :: Ord a => a -> h a -> h a
>   merge     :: Ord a => h a -> h a -> h a
>   findMin   :: Ord a => h a -> a
>   deleteMin :: Ord a => h a -> h a

Lists are an implementation of heaps, but not very efficient.

> instance Heap [] where
>   empty = []
>   isEmpty = null
>   insert = (:)
>   merge = (++)
>   findMin = minimum
>   deleteMin as = let (as1,as2) = break (==findMin as) as
>                    in as1 ++ tail as2

Here is a list sorting algorithm that uses heaps.
First we turn a list into a heap by inserting all the list elements 
into the heap, then we extract them one by one from the heap.
Since the heap always produces the minimum of the values contained in it,
the elements come out in increasing order.

> listHeap :: (Ord a, Heap h) => [a] -> h a
> listHeap = foldl (\h a -> insert a h) empty

You can improve listHeap in the way suggested by Exercise 3.3 in Okasaki.

> heapList :: (Heap h, Ord a) => h a -> [a]
> heapList h = if isEmpty h then [] else findMin h : heapList (deleteMin h)

> selectionSort :: Ord a => [a] -> [a]
> selectionSort = heapList . (listHeap :: Ord a => [a] -> [a])

You can get the slightly better insertion sort algorithm by changing the way insert is defined: insert the new element in the right position.

We had to use a type cast, because Haskell can't derive what instance of the Heap class we want to use.
What we got is a rather inefficient version of selection sort.
But with a more efficient instance of Heap we can get a better sorting algorithm with the same code (just change the type cast).

A much better implementation of heaps is leftist heaps.
A leftist heap is a binary tree such that the rank of the left child is at least as large as the rank of the right child, and both children are themselves leftist heaps.
The rank of a tree is the length of its rightmost branch, also called its right spine.

> data LeftistHeap a = E | T Int a (LeftistHeap a) (LeftistHeap a)
>   deriving (Show,Eq)

The constructor E denotes the empty heap.
A tree of the form (T r x t1 t2) represent a leftist heap with rank r, minimum element x, left child t1 and right child t2.

> rank :: LeftistHeap a -> Int
> rank E = 0
> rank (T r _ _ _) = r

Suppose we have two heaps a and b and a value x.
If we know that x is smaller than all the values contained in a and b, then we can easily make a new heap with x at the root: the left child is the one between a and b with the larger rank, the right child is the other.

> makeT :: a -> LeftistHeap a -> LeftistHeap a -> LeftistHeap a
> makeT x a b = if rank a >= rank b
>                  then T (rank b + 1) x a b
>                  else T (rank a + 1) x b a

> instance Heap LeftistHeap where

>   empty = E

>   isEmpty = (==E)

>   insert x = merge (T 1 x E E)

>   merge h E = h
>   merge E h = h
>   merge h1@(T _ x a1 b1) h2@(T _ y a2 b2)
>     = if x<=y then makeT x a1 (merge b1 h2)
>               else makeT y a2 (merge h1 b2)

>   findMin E = error "empty heap"
>   findMin (T _ x _ _) = x

>   deleteMin E = error "empty heap"
>   deleteMin (T _ _ a b) = merge a b

You can verify that all heap operations preseve the leftist property.

The sorting algorithm that uses leftist heaps is more efficient.
You can prove that it has complexity O(n.log(n)).

> lHeapSort :: Ord a => [a] -> [a]
> lHeapSort = heapList . (listHeap :: Ord a => [a]-> LeftistHeap a)

Hospital example. When patients arrive, they are assigned a priority number.
Low numbers mean high priority. Patients with higher priority must be seen first.

> data Patient = Patient {name::String, priority::Int}
>   deriving (Eq,Show)

> instance Ord Patient where
>   (Patient n1 p1) <= (Patient n2 p2) = p1<=p2

> hospital :: Heap h => h Patient -> IO ()
> hospital h = do
>   putStrLn "Enter \"arrive\" or \"see\":"
>   action <- getLine
>   case action of
>     "arrive" -> do putStr "Name of new patient: "
>                    name <- getLine
>                    putStr "Priority number: "
>                    priority <- fmap read getLine
>                    hospital (insert (Patient name priority) h)
>     "see"    -> do if (isEmpty h)
>                      then putStrLn "No more patients" >> return ()
>                      else do
>                        let (Patient name _) = findMin h
>                        putStrLn $ "Next patient: "++name
>                        hospital (deleteMin h)
>     _        -> putStrLn "Incorrect selection" >> hospital h

When you call this interactive function, you should specify what instance of Heap you're using. For example you can use a leftist heap and start with an empty one by calling:
  hospital (empty :: LeftistHeap Patient)

Exercise:
Add a counter to the hospital function that keeps track of how many patients have been seen. When inserting a new patient, add the counter to the priority number. This guarantees that patients don't have to wait forever.