Hi, I checked the current Fibonacci Queue in Hackage DB: http://hackage.haskell.org/packages/archive/pqueue-mtl/1.0.7/doc/html/src/Data-Queue-FibQueue.html#FQueue
And a history email for Okasaki in 1995: http://darcs.haskell.org/nofib/gc/fibheaps/orig The hardest part is how to consolidate all unordered binomial trees in deleteMin. In imperative implementation, there is a elegant algorithm introduced in Chapter 20 of CLRS[1]. How to achieve it in Functional way is the key point of solve this problem. If we have a list of trees with rank [2, 1, 1, 4, 8, 1, 1, 2, 4], we need first meld the trees with same rank, and recursively doing that until there are no two trees with same rank. Here is a simple function can do this: consolidate:: (Num a)=>[a] -> [a] consolidate xs = foldl meld [] xs where meld :: (Num a)=>[a] -> a -> [a] meld [] x = [x] meld (x':xs) x = if x == x' then meld xs (x+x') else x:x':xs Generalize the `+` to link and `==` to compare rank yields the solution. Below are my literate source code with some description. For the details of Binomial heap, please refer to Okasaki's ``Purely Functional data structures''[2]. -- Definition -- Since Fibonacci Heap can be achieved by applying lazy strategy -- to Binomial heap. We use the same definition of tree as the -- Binomial heap. That each tree contains: -- a rank (size of the tree) -- the root value (the element) -- and the children (all sub trees) data BiTree a = Node { rank :: Int , root :: a , children :: [BiTree a]} deriving (Eq, Show) -- Different with Binomial heap, Fibonacci heap is consist of -- unordered binomial trees. Thus in order to access the -- minimum value in O(1) time, we keep the record of the tree -- which holds the minimum value out off the other children trees. -- We also record the size of the heap, which is the sum of all ranks -- of children and minimum tree. data FibHeap a = E | FH { size :: Int , minTree :: BiTree a , trees :: [BiTree a]} deriving (Eq, Show) -- Auxiliary functions -- Singleton creates a leaf node and put it as the only tree in the heap singleton :: a -> FibHeap a singleton x = FH 1 (Node 1 x []) [] -- Link 2 trees with SAME rank R to a new tree of rank R+1, we re-use the code -- for Binomial heaps link :: (Ord a) => BiTree a -> BiTree a -> BiTree a link t1@(Node r x c1) t2@(Node _ y c2) | x<y = Node (r+1) x (t2:c1) | otherwise = Node (r+1) y (t1:c2) -- Insertion, runs in O(1) time. insert :: (Ord a) => FibHeap a -> a -> FibHeap a insert h x = merge h (singleton x) -- Merge, runs in O(1) time. -- Different from Binomial heap, we don't consolidate the sub trees -- with the same rank, we delayed it later when performing delete- Minimum. merge:: (Ord a) => FibHeap a -> FibHeap a -> FibHeap a merge h E = h merge E h = h merge h1@(FH sz1 minTr1 ts1) h2@(FH sz2 minTr2 ts2) | root minTr1 < root minTr2 = FH (sz1+sz2) minTr1 (minTr2:ts2+ +ts1) | otherwise = FH (sz1+sz2) minTr2 (minTr1:ts1++ts2) -- Find Minimum element in O(1) time findMin :: (Ord a) => FibHeap a -> a findMin = root . minTree -- deleting, Amortized O(lg N) time -- Auxiliary function -- Consolidate unordered Binomial trees by meld all trees in same rank -- O(lg N) time consolidate :: (Ord a) => [BiTree a] -> [BiTree a] consolidate ts = foldl meld [] ts where meld [] t = [t] meld (t':ts) t = if rank t' == rank t then meld ts (link t t') else t:t':ts -- Find the tree which contains the minimum element. -- Returns the minimum element tree and the left trees as a pair -- O(lg N) time extractMin :: (Ord a) => [BiTree a] -> (BiTree a, [BiTree a]) extractMin [t] = (t, []) extractMin (t:ts) = if root t < root t' then (t, ts) else (t', t:ts') where (t', ts') = extractMin ts -- delete function deleteMin :: (Ord a) => FibHeap a -> FibHeap a deleteMin (FH _ (Node _ x []) []) = E deleteMin h@(FH sz minTr ts) = FH (sz-1) minTr' ts' where (minTr', ts') = extractMin $ consolidate (children minTr ++ ts) -- Helper functions fromList :: (Ord a) => [a] -> FibHeap a fromList xs = foldl insert E xs -- general heap sort function, can be re-used for any heap heapSort :: (Ord a) => [a] -> [a] heapSort = hsort . fromList where hsort E = [] hsort h = (findMin h):(hsort $ deleteMin h) -- test testFromList = fromList [16, 14, 10, 8, 7, 9, 3, 2, 4, 1] testHeapSort = heapSort [16, 14, 10, 8, 7, 9, 3, 2, 4, 1] Below are the test results in GHC. *FibonacciHeap> testFromList FH {size = 10, minTree = Node {rank = 1, root = 1, children = []}, trees = [Node {rank = 1, root = 2, children = []},Node {rank = 1, root = 4, children = []},Node {rank = 1, root = 3, children = []},Node {rank = 1, root = 7, children = []},Node {rank = 1, root = 9, children = []},Node {rank = 1, root = 8, children = []},Node {rank = 1, root = 10, children = []},Node {rank = 1, root = 14, children = []},Node {rank = 1, root = 16, children = []}]} *FibonacciHeap> testHeapSort [1,2,3,4,7,8,9,10,14,16] -- [1] Thomas H. Cormen, Charles E. Leiserson, Ronald L. Rivest and Clifford Stein ``Introduction to Algorithms, Second Edition'. The MIT Press © 2001 (1180 pages) ISBN: [2] Chris Okasaki. ``Purely Functional Data Structures''. Cambridge university press, (July 1, 1999), ISBN-13: 978-0521663502 _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe