Programming Praxis – Imperative Heaps

In today’s Programming Praxis exercise, our goal is to implement an array-based heap. Let’s get started, shall we?

We’ll be using Vectors as our array datatype.

import qualified Data.Vector as V

The algorithm assumes that the array is 1-based instead of the usual 0-based. Having to do this at every array lookup would be annoying, so we define a new array index operator.

(!) :: V.Vector a -> Int -> a
v ! i = v V.! (i-1)

Swapping two elements can be done without having to use a temporary variable thanks to Vector’s bulk update feature.

swap :: Int -> Int -> V.Vector a -> V.Vector a
swap i j heap = heap V.// [(i-1, heap ! j), (j-1, heap ! i)]

Sifting up is fairly simple: keep swapping elements with their parents as long as necessary.

siftup :: Ord a => Int -> V.Vector a -> V.Vector a
siftup i heap = let j = div i 2 in if i == 1 || heap ! j <= heap ! i
                then heap else siftup j $ swap i j heap

Sifting down is less convenient, since we need to count up to n, necessitating a worker function. A quick tip on recursive worker functions: make sure they call themselves rather than their parent functions. I initially didn’t, and it took me quite a while to find the bug.

siftdown :: Ord a => Int -> V.Vector a -> V.Vector a
siftdown n = f 1 where
    f i heap = if 2*i > n || heap ! i <= c  then heap
               else f j $ swap i j heap where
                   (c, j) = minimum [(heap ! x, x) | x <- [2*i, 2*i+1], x <= n]

Sorting is a matter of first sifting up and then sifting down.

hsort :: Ord a => V.Vector a -> V.Vector a
hsort heap = foldr (\i -> siftdown (i - 1) . swap 1 i)
             (foldl (flip siftup) heap [2..V.length heap]) [2..V.length heap]

And finally a test to see if everything is working properly.

main :: IO ()
main = print $ hsort (V.fromList [4,7,8,1,5,3,2,9,6]) == V.fromList [9,8..1]

Tags: , , , , , , ,

Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

%d bloggers like this: