99 problems in Haskell, 59-62

Problem 59: Construct height-balanced binary trees.

…aka. AVL trees.

Let’s briefly analyse the AVL tree invariant for our nefarious purposes. We know from CS homework that:

An AVL tree of height h has at least 2^(h/2-1) internal nodes (proof), a fact this problem and problem 60 are unnecessarily vague about
The inductive step of the proof is as follows: An AVL tree of height h >= 3 has two subtrees: one must be of height (h-1) and the other (h-2) (and not (h-3) because the tree is balanced). Therefore: nodes(h) = 1 + nodes(h-1) + nodes(h-2)
For problem 60, we will need to notice these are Fibonacci trees, and we know a Fibonacci tree of order N has F(N+2)-1 nodes, where F(N) is the N-th Fibonacci number. You can prove it by induction on tree height H, or cheat and see the proof here [PDF]

data Tree a = Empty | Branch a (Tree a) (Tree a)
              deriving (Show, Eq)

hbal_tree v 0 = [(0, Empty)]
hbal_tree v 1 = [(1, Branch v Empty Empty)]
-- Build trees which satisfy the invariant:
hbal_tree v n = let subtrees = hbal_tree v (n - 2) ++ hbal_tree v (n - 1)
                in [ (n, Branch v lb rb) | (lh, lb) <- subtrees, (rh, rb) <- subtrees
                                         , n == 1 + max lh rh]
-- Are there height-balanced trees which do not satisfy the invariant above? No - see
-- bullet 2 above.

main = do print $ (map snd) $ hbal_tree 'x' 3

..and you’ll actually notice, that’s cheating - hbal_tree produces tuples. Let’s rewrite it to satisfy the requirement:

hbal_tree v = map snd . hbal_tree'
    where
        hbal_tree' 0 = [(0, Empty)]
        hbal_tree' 1 = [(1, Branch v Empty Empty)]
        hbal_tree' n = let subtrees = hbal_tree' (n - 2) ++ hbal_tree' (n - 1)
                       in [ (n, Branch v lb rb) | (lh, lb) <- subtrees, (rh, rb) <- subtrees
                                                , n == 1 + max lh rh]

main = do mapM_ print $ hbal_tree 'x' 3

While putting this post together, I noticed there’s a simpler way to specify hbal_tree; the possible subtree ‘configurations’ that satisfy the invariant are only 3: those with height (h-2, h-1), (h-1, h-1), and (h-1, h-2). So, with a bit more manual work, the function can be a little more readable (to newbies like myself, I reckon):

hbal_tree x 0 = [Empty]
hbal_tree x 1 = [Branch x Empty Empty]
hbal_tree x h = [Branch x l r | (hl, hr) <- [(h-2, h-1), (h-1, h-1), (h-1, h-2)],
                                l <- hbal_tree x hl, r <- hbal_tree x hr]

Problem 60: Construct height-balanced binary trees with a given number of nodes.

Like we briefly discussed above, AVL trees have some properties which make their construction easier for us:

-- We start with our own datatype,
data Tree a = Empty | Branch a (Tree a) (Tree a)
              deriving (Show, Eq)

-- Let's define the Fibonacci sequence:
fib :: [Int]
fib = 0 : 1 : zipWith (+) fib (tail fib)

-- Like we proved 10 years ago and noted above, the minimum number of nodes in a
-- height-balanced tree of height h:
min_nodes h = fib !! (h + 2) - 1
-- and the maximum:
max_nodes h = 2^h - 1

-- Now, properties of height. A height-balanced tree of n nodes has minimum height:
min_height n = ceiling $ logBase 2 $ fromIntegral (n + 1)
-- and maximum height:
max_height n = length (takeWhile (<= n+1) fib) - 3

-- So now we can generate AVL trees:
hbal_tree_nodes x n = [t | h <- [min_height n .. max_height n], t <- balanced_tree h n]
    where
        balanced_tree 0 n = [Empty]
        balanced_tree 1 n = [Branch x Empty Empty]
        -- OK this list comprehension was tricky to write.
        -- We want all the trees with subtrees with heights that fit the balanced
        -- invariant (difference is less than 1). And, since we can calculate the number
        -- of nodes needed for those heights, we do so recursively:
        balanced_tree h n = [Branch x l r | (hl, hr) <- [ (h-2, h-1), (h-1, h-1), (h-1, h-2)]
                                          , let min_nl = max (min_nodes hl) (n - 1 - max_nodes hr)
                                          , let max_nl = min (max_nodes hl) (n - 1 - min_nodes hr)
                                          , nl <- [min_nl .. max_nl]
                                          , let nr = n - 1 - nl
                                          , l <- balanced_tree hl nl
                                          , r <- balanced_tree hr nr]

main = do print $ length $ hbal_tree_nodes 'x' 15
          mapM_ print $ map (hbal_tree_nodes 'x') [0..3]
          -- It seems to work, but is it correct?

I think it’s a little bit amazing how we can generate AVL trees without repeated insertions and rotations.

Problem 61: Count the leaves of a binary tree & collect the leaves of a binary tree in a list.

This was surprisingly easy:

count_leaves :: Tree a -> Int
count_leaves Empty = 0
count_leaves (Branch _ Empty Empty) = 1
count_leaves (Branch _ l r) = (count_leaves l) + (count_leaves r)

leaves :: Tree a -> [a]
leaves Empty = []
leaves (Branch v Empty Empty) = [v]
leaves (Branch v l r) = (leaves l) ++ (leaves r)

Problem 62: Collect the internal nodes of a binary tree in a list & collect the nodes at a given level in a list

Basically, the inversion of the problem above:

internals :: Tree a -> [a]
internals Empty = []
internals (Branch _ Empty Empty) = []
internals (Branch v l r) = [v] ++ (internals l) ++ (internals r)

atlevel :: Tree a -> Int -> [a]
atlevel Empty _ = []
atlevel (Branch v l r) n | n == 1 = [v]
                         | n > 1  = atlevel l (n - 1) ++ atlevel r (n - 1)
                         | otherwise = []

The next problems involve more trees, yay! See you in a few.

« Past Future »