-- 
-- This file Copyright 2001 Jeffrey B Putnam
-- Please Contact me - jefu@eou.edu - for information 
-- 
data Ord a => PairHeap a = PH a [(PairHeap a)] | Empty 

insert x Empty = PH x [] 

insert x h@(PH a l)  
  | x > a             = PH a ((PH x []):l)
  | otherwise         = PH x [h] 

isEmpty   Empty       = True 
isEmpty   _           = False 

getMin    (PH a l)    = a 
getMin    Empty       = error "get min of empty"

merge  Empty  Empty   = Empty 
merge  x      Empty   = x 
merge  Empty  x       = x 
merge     x@(PH a l) y@(PH b l1) 
    | a < b           = PH a (y:l) 
    | otherwise       = PH b (x:l1) 

mergeL []             = Empty 
mergeL [x]            = x 
mergeL (x:x1:xs)      = merge (merge x x1) (mergeL xs) 

deleteMin (PH a l)    = mergeL l 

----------

listToHeap l              = foldr insert Empty l 

heapToList Empty          = [] 
heapToList h              = (getMin h):(heapToList (deleteMin h)) 

heapSort l                = heapToList (listToHeap l)  

ulam x 
  |  x `mod` 2 == 0       = x `div` 2
  |  otherwise            = 3 * x + 1 

ul 1                      = [1] 
ul x                      = x:(ul (ulam x))

testHeapSort              = heapSort.ul