99 problems in Haskell, 63-68

2015 Aug 13

Problem 63: Construct a complete binary tree.

A complete binary tree of height H has the maximum amount of nodes, 2^(i - 1), at level i. At any level which contains less than the maximum amount of nodes, all its nodes are left-adjusted. Once again, we can make do with the addressing scheme introduced from AVL trees earlier on:

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

complete_binary_tree :: Int -> Tree Char
complete_binary_tree n = complete_binary_tree' 1
    where
        complete_binary_tree' a | a > n = Empty
                                | otherwise = Branch 'x' (complete_binary_tree' (2 * a)) (complete_binary_tree' (2 * a + 1))

-- In levelorder, the first Empty node should be immediately after the last non-Empty.
-- "First Empty node" is the Empty node with the smallest address. The "last non-Empty" is
-- the Branch node with the greatest address.
is_complete_binary_tree :: Tree a -> Bool
-- "fen - first empty node"
-- "lnn - last nonempty node"
is_complete_binary_tree t = fen == lnn + 1 -- Strict
    where
        -- Same logic as in `complete_binary_tree`. Compute addresses from the root:
        (lnn, fen) = maxmin t 1
        maxmin Empty m = (0, m)
        maxmin (Branch _ l r) m = (max m $ max max_left max_right, min min_left min_right)
            where
                (max_left, min_left) = maxmin l (2 * m)
                (max_right, min_right) = maxmin r (2 * m + 1)

main = do let cbt4 = (complete_binary_tree 4)
          print $ is_complete_binary_tree cbt4

Problem 64: Annotate tree nodes.

In this problem, the first coordinate is the position of node v in the tree’s inorder sequence, and the second coordinate is the level of the node in the tree.

We pass two coordinates to a helper function, the second is used to mark the current level straightforwardly. The first is a little more involved, and it’s easy to get lost in figuring it out - I know I was. Instead of computing the inorder sequence and indexing it, which we could do, we’re going to observe that every node’s position in the inorder sequence equals to the number of elements in its left subtree, plus one (±1 whether you decide to number from 0 or 1, doesn’t matter).

We can track that number by propagating x down the tree, increasing it as we traverse each node’s right subtree. We can record x after we’ve finished propagating down the left subtree and before the right one (in-order), let’s call that x'.

I think that was probably less convoluted in my head.

layout t = fst (layout' 1 1 t)
    where
        layout' x y Empty = (Empty, x)
        layout' x y (Branch v l r) = (Branch (v, (x', y)) l' r', x'')
            where
                (l', x') = layout' x (y + 1) l
                (r', x'') = layout' (x' + 1) (y + 1) r

Problem 65: Annotate tree nodes.

An alternative layout this time. I have no idea what the rules are (yet).

Problem 66: Annotate tree nodes, again.

Ditto.

Problem 67: String representation of binary trees.

tree_to_string is the standard preorder traversal.

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

tree_to_string :: Tree Char -> String
tree_to_string Empty = ""
tree_to_string (Branch v Empty Empty) = [v]
tree_to_string (Branch v l r) = v : "(" ++ tree_to_string l ++ "," ++ tree_to_string r ++ ")"

The inverse is a little more involved. The major flaw in my solution is strings starting with comma or right parenthesis aren’t treated as parse errors.

string_to_tree :: String -> Tree Char
string_to_tree str = snd $ helper str
    where
        helper "" = ("", Empty)
        helper [x] = ("", Branch x Empty Empty)
        -- Let's handle the cases where the first character's either a parenthesis
        -- or comma:
        helper t@(v:y:ys) | v == ',' || v == ')' = (y:ys, Empty) -- This should be a parse error,
                                                                 -- but the lookahead
                                                                 -- confuses me
                          | v == '(' = error "parse error - left parenthesis before value"
                          | y == '(' = let { (lrest, lt) = helper ys; (rrest, rt) = helper lrest }
                                        in (rrest, Branch v lt rt)
                          | y == ',' || y == ')' = (ys, Branch v Empty Empty)
                          | otherwise = error "parse error"

Problem 68: Preorder and inorder sequences of binary trees.

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

preorder :: Tree Char -> String
preorder Empty = ""
preorder (Branch v l r) = [v] ++ preorder l ++ preorder r

inorder :: Tree Char -> String
inorder Empty = ""
inorder (Branch v l r) = inorder l ++ [v] ++ inorder r

-- Note that the requirement is for the two trees to have identical preorder sequences,
-- and NOT for the resulting trees to be identical:
pre_to_tree :: String -> Tree Char
pre_to_tree "" = Empty
pre_to_tree (x:xs) = Branch x Empty (pre_to_tree xs)

pre_in_tree :: String -> String -> Tree Char
pre_in_tree "" "" = Empty
pre_in_tree po@(x:xs) io = Branch x l r
    where
        (lio, _ : rio) = break (==x) io
        (lpo, rpo) = splitAt (length lio) xs
        l = pre_in_tree lpo lio
        r = pre_in_tree rpo rio
pre_in_tree _ _ = error "Invalid tree specified"

main = do let { t = Branch 'a' (Branch 'b' (Branch 'd' Empty Empty) (Branch 'e' Empty Empty)) Empty
              ; po = preorder t
              ; io = inorder t }
              in print $ pre_in_tree po io
« Past Future »