Is it possible to build a heap from the root to the leaves?

Question

Most books on data-structures will briefly introduce heaps (aka priority queues) and then move to describe the "trick" allowing heaps to be implemented as arrays.

I've been looking for a way to implement a heap as an actual tree (call it pointers to structs, cons cells etc.) This would also imply building the heap from the root to the leaves (since it won't be practical to hold references to all the leaves).

With some effort I'm able to make the resulting heap to arrange the nodes s.t. the parent is greater than the children, but I cannot think of a way to also balance it.

---

If you are interested, the motivation for this exercise is: Prolog and its dialects don't really have arrays (they kind of do, but they are almost immutable). Besides, in languages where persistent data structures are a big deal, the usual construction of heap would be problematic.

---

Idea #1

I have a feeling that rotating (switching left and right nodes places) may take care of balancing (still need to try this).

Answer 1

{-

Yes, you can implement a priority queue using a complete binary tree in a purely functional way. You don't need parent pointers or pointers to the left or right most elements to get the same asymptotic complexity as the usual binary heaps.

This post is Haskell, with the prose enclosed in comments. You can copy and paste it and it should work in GHC 7.6.3, modulo a number of indentation mistakes caused by StackOverflow's buggy markdown implementation.

It requires LazySmallCheck, but if you don't want to install that, you can comment out that import line and the single test that uses ==>.

-}

module BinaryHeap
       (BinaryHeap, -- The type of heaps
        size,       -- O(1): the number of elements in a heap
        emptyHeap,  -- The heap of size 0
        insert,     -- O(log n): add a value to a heap
        deleteMin,  -- O(log n): remove a value from a heap
        toHeap,     -- O(n): create a heap from a list faster than foldr insert
        toList)     -- O(n): create a list from a heap faster than foldr deleteMin
       where

import Control.Monad(guard)
import Data.Maybe(isJust, fromJust)
import Test.LazySmallCheck((==>))

data Tree a = Tip | Top a (Tree a) (Tree a) deriving (Show, Read)

{-

A full binary tree of depth n is either the empty tree if n is 0 or a tree in which both child subtrees of the root are full binary trees of depth n-1.

-}

full Tip = Just 0
full (Top _ x y) =
  do n <- full x
     m <- full y
     guard (n == m)
     return (1+n)

{-

A complete binary tree of depth n+1 is a full binary tree of depth n along with a partially filled last level, as long as the last level is filled from left to right, contiguously.

The function "complete" is a recursive vesion of that. It is used for testing. The idea is that there are four ways that a tree can be complete:

1. Both child subtrees of the root are full trees of the same height

2. Both child subtrees of the root are full trees, but the left subtree is one level deeper than the right one.

3. The left subtree is full, the right subtree is complete, and they have the same height.

4. The right subtree is full, the left subtree is complete, and the left subtree has depth one more than the right subtree.

Thus:

-}

data Completetion = Full | Part deriving (Read, Show)

complete Tip = Just (Full, 0)
complete (Top _ x y) =
  do (a,b) <- complete x
     (p,q) <- complete y
     case (a,p,b-q) of
       (Full, Full, 0) -> Just (Full, b+1)
       (Full, Full, 1) -> Just (Part, b+1)
       (Full, Part, 0) -> Just (Part, b+1)
       (Part, Full, 1) -> Just (Part, b+1)
       _ -> Nothing

{-

Unlike more loosely-constrained balanced trees like AVL trees or tries, the shape of a complete tree is determined entirely by its size. Additionally, a complete tree of size n differs in only one location from a complete tree of size n+1. For instance, a tree of size 6 can be turned into a tree of size 7 by adding a right-most grandchild of the root.

Like many data structures, especially purely-functional ones, structure and location can be dealt with more simply by considering representations of the numbers of the sizes of the structure.

Consider, for instance, the paths from the root of the nodes that are added to a tree of size 7 to turn it into a tree of size 8, then 9, then 10, all the way up to 15. A tree of size 7 is full, so the next node is added as the leftmost child of the root. The path to that node is

Left, Left, Left

The next node is at the path

Left, Left, Right.

I'll continue writing these, but I'll denote Left by 0 and Right by 1, and I'll omit the commas. Starting at the 8th node, we have

000
001
010
011
100
101
110
111

These are the representations of the numbers 0 through 7 in binary, written bigendianly. If you add a 1 at the front of each, then the path to the nth node added to a complete tree is just the binary representation of n.

So, to make a complete tree of size n:

1. Put n into a big-endian binary format, then drop the first 1.

2. (a) If the next bit is 0, the nth node goes in the left subtree, so the right subtree is full and has height one less than the left subtree.

   (b) If the next bit is 1, the nth node goes in the right subtree, so the left subtree is full and has the same height as the left subtree.

3. Drop the most significant bit from the representation and recurse, using #2.

To turn this into a method for turning a list into a complete tree, first find the length of the list, then make a complete tree of that size, then put the values from the lists at the locations in the tree.

-}

makeFull [] = Tip
makeFull (_:xs) = let c = makeFull xs in Top () c c

makeComplete [] = Tip
makeComplete (False:xs) = Top () (makeComplete xs) (makeFull xs)
makeComplete x@(True:xs) = Top () (makeFull x) (makeComplete xs)

littleEndian 1 = []
littleEndian x = (odd x):(littleEndian (x `div` 2))

bigEndian x = reverse $ littleEndian x

preOrder [] _ = (Tip, [])
preOrder xs Tip = (Tip, xs)
preOrder (x:xs) (Top _ p q) =
  let (p',ys) = preOrder xs p
      (q',zs) = preOrder ys q
  in (Top x p' q', zs)

toComplete xs =
  let t = makeComplete $ bigEndian $ 1 + length xs
  in fst $ preOrder xs t

-- Tests for makeComplete

completeTest x = isJust $ complete $ makeComplete x

treeSize Tip = 0
treeSize (Top _ x y) = 1 + treeSize x + treeSize y

completeSizedTest n =
  (n >= 0) ==> (let t = makeComplete $ bigEndian (1+n)
                in n == treeSize t)

{-

Now that we have put the list into a complete tree, we can use the textbook linear-time heapify to turn that tree into a heap.

-}

pushDown x@Tip = x
pushDown x@(Top _ Tip Tip) = x
pushDown (Top x Tip y) = pushDown (Top x y Tip)
pushDown x@(Top p (Top q rt st) Tip) =
  if p <= q
  then x
  else Top q (pushDown $ Top p rt st) Tip
    pushDown x@(Top p y@(Top q rt st) z@(Top u vt wt))
      | p <= q && p <= u = x
      | q <= p && q <= u = Top q (pushDown $ Top p rt st) z
  | u <= p && u <= q = Top u y (pushDown $ Top p vt wt)

heapify Tip = Tip
heapify (Top x y z) =
  let y' = heapify y
      z' = heapify z
  in pushDown $ Top x y' z'

makeHeap xs = heapify $ toComplete xs

isHeap Tip = True
isHeap (Top x Tip Tip) = True
isHeap (Top x ys@(Top y _ _) Tip) = x <= y && isHeap ys
isHeap (Top x ys@(Top y _ _) zs@(Top z _ _)) =
  x <= y && x <= y && isHeap ys && isHeap zs

heapTest xs = let h = makeHeap xs in isHeap h && (isJust $ complete h)

{-

To add or delete a node, we need to know where the "last" node in a binary heap is, but this is completely determined by the size by just turning its binary representation (bigendian) into a path in the tree.

After we have the location, we can follow the textbook insert and delete operations on a binary heap.

Note that we do not need multiple pointers or anything fancy in the structure itself, which remains just an int (the size) and a bog-standard binary tree.

-}

data BinaryHeap a =
  BinaryHeap {size :: Int, values :: Tree a}
  deriving (Show, Read)

emptyHeap = BinaryHeap 0 Tip

toListHelp [] [] = []
toListHelp [] r = toListHelp (reverse r) []
toListHelp (Tip:xs) r = toListHelp xs r
toListHelp ((Top a b c):xs) r = a:(toListHelp xs (c:b:r))

toList (BinaryHeap _ x) = toListHelp [x] []

toHeap xs = let n = length xs in BinaryHeap n (makeHeap xs)

popHelp [] (Top x Tip Tip) = (x, Tip)
popHelp (False:xs) (Top p qt rt) =
  let (ans, qt') = popHelp xs qt
  in (ans, Top p qt' rt)
popHelp (True:xs) (Top p qt rt) =
  let (ans, rt') = popHelp xs rt
  in (ans, Top p qt rt')

popBottom n t = popHelp (bigEndian n) t

deleteMin (BinaryHeap 1 (Top x Tip Tip)) = (x, BinaryHeap 0 Tip)
deleteMin (BinaryHeap n t@(Top x yt zt)) =
  let (bottom, smallTree) = popBottom n t
  in (x, BinaryHeap (n-1) (pushDown $ Top bottom yt zt))

insertHelp [] x Tip = Top x Tip Tip
insertHelp (False:xs) v (Top p qt rt) =
  if v < p
  then Top v (insertHelp xs p qt) rt
  else Top p (insertHelp xs v qt) rt
insertHelp (True:xs) v (Top p qt rt) =
  if v < p
  then Top v qt (insertHelp xs p rt)
  else Top p qt (insertHelp xs v rt)

insert x (BinaryHeap n t) =
  let m = bigEndian (1+n)
  in BinaryHeap (1+n) (insertHelp m x t)

Answer 2

Binary heaps are one possible implementations for priority queues. Although their operations are best understood as binary trees, their implementation as arrays is essential. They are stored efficiently, due to the perfect balance you mention, and do not need explicit pointers to children or parent (as these are found by calculating their index in the array).

There is a very cute data structure (on the implementation level) for priority queues that is based on binary trees, has the same heap ordering of keys, but is not perfectly balanced. They are called leftist trees. Arbitrary leftist trees can be merged efficiently. This efficiency is obtained by forcing a height balance between the two subtrees of a node. The shortest distance to a leaf is the measure for this balance.

Perhaps these leftist trees are a better binary tree implementation for priority queues than heaps (which are arrays disguised as trees)?