4
\$\begingroup\$

Here's a partial binomial heap implementation in Haskell (just merge and insert):

module BinomialHeap where

data BinomialTree a = Tree { key :: a
                           , order :: Integer
                           , subTrees :: [BinomialTree a] 
                           } deriving (Show)

data BinomialHeap a = Heap [BinomialTree a]
instance (Show a) => Show (BinomialHeap a) where
    show (Heap trees) = unlines $ map show trees

addSubTree :: BinomialTree a -> BinomialTree a -> BinomialTree a
addSubTree a b = a { subTrees = b:(subTrees a)
                   , order = succ $ order a }

mergeTree :: Ord a => BinomialTree a -> BinomialTree a -> BinomialTree a
mergeTree a b
    | key a > key b = b `addSubTree` a
    | otherwise = a `addSubTree` b

merge :: Ord a => BinomialHeap a -> BinomialHeap a -> BinomialHeap a
merge (Heap as) (Heap bs) = Heap . reverse $ recur as bs []
    where recur [] [] acc = acc
          recur ts [] acc = foldl (flip mergeDown) acc ts
          recur [] ts acc = foldl (flip mergeDown) acc ts
          recur (t:rest) (t':rest') acc
              | order t == order t' = recur rest rest' $ mergeDown (mergeTree t t') acc
              | order t > order t' = recur (t:rest) rest' $ mergeDown t' acc
              | otherwise = recur rest (t':rest') $ mergeDown t acc
          mergeDown t [] = [t]
          mergeDown t (t':rest)
              | order t == order t' = mergeDown (mergeTree t t') rest
              | otherwise = t:t':rest

insert :: Ord a => a -> BinomialHeap a -> BinomialHeap a
insert elem heap = merge heap $ Heap [Tree elem 0 []]

empty :: BinomialHeap a
empty = Heap []

fromList :: Ord a => [a] -> BinomialHeap a
fromList = foldl (flip insert) empty

Written based on the explanation from the wiki. It seems to work ok:

Prelude> :load "BinomialHeap.hs"
[1 of 1] Compiling BinomialHeap     ( BinomialHeap.hs, interpreted )
Ok, modules loaded: BinomialHeap.
*BinomialHeap> fromList [9,3,2,8,4,2,1]
Tree {key = 1, order = 0, subTrees = []}
Tree {key = 2, order = 1, subTrees = [Tree {key = 4, order = 0, subTrees = []}]}
Tree {key = 2, order = 2, subTrees = [Tree {key = 3, order = 1, subTrees = [Tree {key = 9, order = 0, subTrees = []}]},Tree {key = 8, order = 0, subTrees = []}]}

*BinomialHeap> fromList [8,7,6,1,9,8,2,7,3,8,2,9,1,7,3]
Tree {key = 3, order = 0, subTrees = []}
Tree {key = 1, order = 1, subTrees = [Tree {key = 7, order = 0, subTrees = []}]}
Tree {key = 2, order = 2, subTrees = [Tree {key = 3, order = 1, subTrees = [Tree {key = 8, order = 0, subTrees = []}]},Tree {key = 9, order = 0, subTrees = []}]}
Tree {key = 1, order = 3, subTrees = [Tree {key = 2, order = 2, subTrees = [Tree {key = 8, order = 1, subTrees = [Tree {key = 9, order = 0, subTrees = []}]},Tree {key = 7, order = 0, subTrees = []}]},Tree {key = 7, order = 1, subTrees = [Tree {key = 8, order = 0, subTrees = []}]},Tree {key = 6, order = 0, subTrees = []}]}

*BinomialHeap> fromList [3,9,4,8,2,1,9,8,4,2,1,0,3,9,4,8,2,1,0,4,8,9,8,4,3,2,3]
Tree {key = 3, order = 0, subTrees = []}
Tree {key = 2, order = 1, subTrees = [Tree {key = 3, order = 0, subTrees = []}]}
Tree {key = 0, order = 3, subTrees = [Tree {key = 4, order = 2, subTrees = [Tree {key = 8, order = 1, subTrees = [Tree {key = 9, order = 0, subTrees = []}]},Tree {key = 8, order = 0, subTrees = []}]},Tree {key = 1, order = 1, subTrees = [Tree {key = 2, order = 0, subTrees = []}]},Tree {key = 4, order = 0, subTrees = []}]}
Tree {key = 0, order = 4, subTrees = [Tree {key = 1, order = 3, subTrees = [Tree {key = 3, order = 2, subTrees = [Tree {key = 4, order = 1, subTrees = [Tree {key = 8, order = 0, subTrees = []}]},Tree {key = 9, order = 0, subTrees = []}]},Tree {key = 8, order = 1, subTrees = [Tree {key = 9, order = 0, subTrees = []}]},Tree {key = 2, order = 0, subTrees = []}]},Tree {key = 3, order = 2, subTrees = [Tree {key = 4, order = 1, subTrees = [Tree {key = 8, order = 0, subTrees = []}]},Tree {key = 9, order = 0, subTrees = []}]},Tree {key = 2, order = 1, subTrees = [Tree {key = 4, order = 0, subTrees = []}]},Tree {key = 1, order = 0, subTrees = []}]}

*BinomialHeap> 

But merge looks a lot more complicated than I'd assume based on this pseudocode. Without the extra merge-down step, I end up getting "Heaps" with multiple trees of the same order.

I'd rather get advice on the data structure rather than Haskell style, but both are welcome. Also, I'm doing this for educational purposes, so I didn't bother checking for an existing implementation on hackage, though I'm sure there is one.

\$\endgroup\$
  • \$\begingroup\$ It's been almost four years. Do you want to review your own code? \$\endgroup\$ – Zeta Apr 11 '18 at 14:48

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.