## Posts Tagged ‘heap’

### Programming Praxis – Imperative Heaps

January 25, 2013

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]```

### Programming Praxis – Priority Queues

May 5, 2009

Today’s Programming Praxis problem is about priority queues. Specifically, we have to implement one using a Leftist Heap.

We define a priority queue as follows. It’s basically a binary tree, but with an extra field in which we store the rank.

`data PQueue a = Node Int a (PQueue a) (PQueue a) | Empty`

Empty nodes have rank 0.

```rank :: PQueue a -> Int
rank Empty          = 0
rank (Node r _ _ _) = r```

A convenience function for node creation that calculates the rank automatically:

```node :: a -> PQueue a -> PQueue a -> PQueue a
node i l r = if rank l > rank r then node i r l else Node (1 + rank r) i l r```

Two priority queues can be merged as follows:

```merge :: (a -> a -> Bool) -> PQueue a -> PQueue a -> PQueue a
merge _ Empty q = q
merge _ q Empty = q
merge p l@(Node _ il _ _) r@(Node _ ir lc rc) =
if p ir il then node ir lc (merge p l rc) else merge p r l```

To insert an item into a priority queue we make a new queue out of it and merge it into our original queue.

```insert :: (a -> a -> Bool) -> a -> PQueue a -> PQueue a
insert p i = merge p (node i Empty Empty)```

We convert a list to a priority queue by inserting all the items into an empty queue.

```fromList :: (a -> a -> Bool) -> [a] -> PQueue a
fromList p = foldr (insert p) Empty```

And to do the opposite we keep taking the root of the queue and merging its branches.

```toList :: (a -> a -> Bool) -> PQueue a -> [a]
toList _ Empty          = []
toList p (Node _ i l r) = i : toList p (merge p l r)```

With these functions, we can easily sort a list on priority by converting it to a priority queue and back.

```pqSort :: (a -> a -> Bool) -> [a] -> [a]
pqSort p = toList p . fromList p```

And finally we test if everything works ok.

```main :: IO ()
main = print \$ pqSort (<) [3, 7, 8, 1, 2, 9, 6, 4, 5]```

30 lines counting white space. Not bad.