Discrete Math Using a Computer: Chapter 05 Trees notes and exercise solutions

DiscreteMathComputer05.hs

{- Discrete Mathematics Using a Computer
   Chapter 05: Trees
-}

-- =============================================================================
-- 5.1 Components of a Tree

{-
Definition 1: A tree is either an empty tree or it is a node together with a sequence of trees.

Definition 2: The node portion of a non-empty tree is called the root of a tree. The sequence of trees are called the children of the root

Definition 3: A non-empty tree whose associated sequence of trees is empty is called a leaf.

Definition 4: A tree s is said to be a subtree of t if:
  - s is the same as t (every tree is a subtree of itself)
  - if t is nonempty, s is a child of t or a subtree of a child of t
    - this can be simplified by saying "s is a subtree of a  child of tree" because each tree is a subtree of itself

Definition 5: A tree s is said to be a leaf of a tree t if s is a subtree of t and s is a leaf.

Definition 6: A node n is said to occur in a tree t, written n \in t, if t consists of a node m together with a sequence of trees [s1,s2,...] 
and either n is the same as m or n occurs in one of the children of t

Definition 7: A node n is said to be an interior node in the tree if n occurs in t and there is a sequence of trees [s1, s2, ...] 
such that n together with [s1, s2, ...] is a subtree of t.
-}

-- =============================================================================
-- 5.2 Representing Trees in Haskell

-- The book defines a binary tree, but I'm going to define tree based on the defn above.

data Tree a = Leaf
            | Node a [Tree a]
            deriving (Eq, Show)

--------------------------------------------------------------------------------
-- Ex 1: Define a datatype Tree1 for a tree that contains a character and an integer in each node, along with exactly three subtrees

data Tree1 = Leaf1
           | Node1 (Char, Int) Tree1 Tree1 Tree1
           deriving (Show)
                    
--------------------------------------------------------------------------------
-- Ex 2: datatype Tree2 contains an integer at each node, and any number of subtrees

type Tree2 = Tree Integer

-- =============================================================================
-- 5.3 Processing Trees with Recursion

{- Preorder: visit root, then left subtree, then right subtree
   Inorder: visit left, then root, then right
   Postorder: visit left, then right, then root

These aren't sensible for my Tree because my tree has no notion of "left"
and "right". I guess I could have two lists one representing the nodes at the 
"left" of node, and another representing the nodes right of root.
-}

-- gen for "general" haha
data GenTree a = GenLeaf
               | GenNode a [GenTree a] [GenTree a]
               deriving (Eq, Show)

-- draw out the following tree (easier to visualize)
exampleGenTree :: GenTree Integer
exampleGenTree = GenNode 7 [genSubtree3, genSubtree5] [genSubtree9]
  where genSubtree3 = GenNode 3 [genSubtree1] [genSubtree4]
        genSubtree1 = GenNode 1 [GenLeaf] [GenLeaf]
        genSubtree4 = GenNode 4 [GenLeaf] [GenLeaf]
        genSubtree5 = GenNode 5 [GenLeaf] [GenNode 6 [GenLeaf] [GenLeaf]]
        genSubtree9 = GenNode 9 [GenNode 8 [GenLeaf] [GenLeaf]] [GenNode 10 [GenLeaf] [GenLeaf]]

inorder:: GenTree a -> [a] 
inorder GenLeaf = []
inorder (GenNode root left right) = inorder' left ++ [root] ++ inorder' right
  where inorder' :: [GenTree a] -> [a]
        inorder' = concat . map inorder

-- > inorder exampleGenTree
-- [1,3,4,5,6,7,8,9,10]

preorder :: GenTree a -> [a]
preorder GenLeaf = []
preorder (GenNode root left right) = [root] ++ preorder' left ++ preorder' right
  where preorder' :: [GenTree a] -> [a]
        preorder' = concat . map preorder
        
postorder :: GenTree a -> [a]
postorder GenLeaf = []
postorder (GenNode root left right) = postorder' left ++ postorder' right ++ [root]
  where postorder' = concat . map postorder
        
--------------------------------------------------------------------------------
-- Ex 3: Calculate the inorder traversal of exampleGenTree
-- [1,3,4,5,6,7,8,9,10]
        
--------------------------------------------------------------------------------
-- Ex 4: Write a function inorderf :: (a -> b) -> GenTree a -> [b]
-- Traverses in order and applies f to each value
        
inorderf f = map f . inorder

--------------------------------------------------------------------------------
-- Processing Tree Structure
-- Reflect returns a binary tree where everything is reflected left-to-right

reflect :: GenTree a -> GenTree a
reflect GenLeaf = GenLeaf
reflect (GenNode root left right) = GenNode root (flipsub right) (flipsub left)
  where flipsub = reverse . map reflect

-- *Main> inorder (reflect exampleGenTree)
-- [10,9,8,7,6,5,4,3,1]

height :: GenTree a -> Integer
height GenLeaf = 0
height (GenNode _ left right) = 1 + max (maxsub left) (maxsub right)
  where maxsub = maximum  . map height

size :: GenTree a -> Integer
size GenLeaf = 0
size (GenNode _ left right) = 1 + sumsub left + sumsub right
  where sumsub = sum . map size

-- *Main> height exampleGenTree
-- 3
-- *Main> size exampleGenTree
-- 9

-- Note size exampleGenTree should be length . inorder/preorder/postorder
-- because there can be many subtrees, i've defined balanced to mean that the maximum height of left subtree is equal to the maximum height of the right subtree
balanced :: GenTree a -> Bool
balanced GenLeaf = True
balanced (GenNode _ left right) = balsub left && balsub right && (maximum (map height left) == maximum (map height right))
  where balsub :: [GenTree a] -> Bool
        balsub = and . map balanced

-- *Main> balanced exampleGenTree
-- False
-- *Main> balanced GenLeaf
-- True
-- *Main> balanced (GenNode 3 [GenNode 1 [GenLeaf] [GenLeaf]] [GenNode 4 [GenLeaf] [GenLeaf]])
-- True

--------------------------------------------------------------------------------
-- Ex 5: highest and shortest binary trees containing 7 elements

-- shortest is the fully balanced one
-- highest is the one that looks like a chain

--------------------------------------------------------------------------------
-- Ex 6: we modify the balanced clause to be:
-- balanced BinLeaf = True
-- balanced (BinNode x t1 t2) = balanced t1 && balanced t2

-- Give a counterexample for this.
{-                  1
                  2   3
                     4  5

Notation: {1} means tree rooted at 1
balanced {1}
=> balanced {2} && balanced {3}
=> (balanced {} && balanced {}) && balanced {3}
=> (True && True) && balanced {3}
=> balanced {3}
=> balanced {4} && balanced {5}
=> (balanced {} && balanced {}) && (balanced {} && balanced {})
=> True

WAIT! actually the following would work as well!
  balanced              1
                       2
-}

--------------------------------------------------------------------------------
-- Ex 7: we modify balanced to be:
{- balanced BinLeaf = True
   balanced (BinNode x t1 t2) = height t1 == height t2

Give a counterexample for this.

                       1
                     2   3
                   4       5
                 6           7
balanced {1}
= height {2} == height {3}
= 3 == 3
= True

but the trees are not balanced.

-}

--------------------------------------------------------------------------------
-- Binary Search Trees

linearSearch :: Eq a => a -> [(a, b)] -> Maybe b
linearSearch x [] = Nothing
linearSearch key ((x,y):xs)
  | key == x = Just y
  | otherwise = linearSearch key xs
                
-- using higher order functions
linearSearch' :: Eq a => a -> [(a, b)] -> Maybe b
linearSearch' key = safeHead . filter ((== key) . fst)
  where safeHead :: [(a,b)] -> Maybe b
        safeHead [] = Nothing
        safeHead ((a,b):_) = Just b
        
-- *Main> linearSearch' 10 (zip [1..20] ['a'..'z'])
-- Just 'j'
-- *Main> linearSearch 10 (zip [1..20] ['a'..'z'])
-- Just 'j'
  

-- binary search on binary trees
-- insertion on binary trees

--------------------------------------------------------------------------------
-- Ex 8: mapTree

mapTree :: (a -> b) -> GenTree a -> GenTree b
mapTree f GenLeaf = GenLeaf
mapTree f (GenNode val left right) = GenNode (f val) (map (mapTree f) left) (map (mapTree f) right)

--------------------------------------------------------------------------------
-- Ex 9: concatTree
-- "takes a tree of lists and concatenates the lists in order from left to right"
concatTree :: GenTree [a] -> [a]
concatTree = concat . inorder

-- *Main> concatTree (mapTree (\ x -> [x]) exampleGenTree)
-- [1,3,4,5,6,7,8,9,10]
-- *Main> inorder exampleGenTree
-- [1,3,4,5,6,7,8,9,10]

--------------------------------------------------------------------------------
-- Ex 10: zipTree

-- the book talks about returning Nothing if the two trees don't have the same shape
-- but i think a better thing to do is to return a GenLeaf for those trees.

zipTree :: GenTree a -> GenTree b -> GenTree (a,b)
zipTree _ GenLeaf = GenLeaf
zipTree GenLeaf _ = GenLeaf
zipTree (GenNode lval lleft lright) (GenNode rval rleft rright) = GenNode (lval, rval) (zipWith zipTree lleft rleft) (zipWith zipTree lright rright)

-- *Main> zipTree exampleGenTree (mapTree (* 2) exampleGenTree)
-- GenNode (7,14) [GenNode (3,6) [GenNode (1,2) [GenLeaf] [GenLeaf]] [GenNode (4,8) [GenLeaf] [GenLeaf]],GenNode (5,10) [GenLeaf] [GenNode (6,12) [GenLeaf] [GenLeaf]]] [GenNode (9,18) [GenNode (8,16) [GenLeaf] [GenLeaf]] [GenNode (10,20) [GenLeaf] [GenLeaf]]]

--------------------------------------------------------------------------------
-- Ex 11: zipWithTree

zipWithTree :: (a -> b -> c) -> GenTree a -> GenTree b -> GenTree c
zipWithTree f t1 t2 = mapTree (uncurry f) $ zipTree t1 t2

-- =============================================================================
{- 5.4 Induction on Trees

Principle of Induction on Trees
  Base Case: P(Leaf)
  Inductive Case: Assuming that P holds for the subtrees, does it hold for a node which has a particular value and subtrees where P holds?

--------------------------------------------------------------------------------
Theorem: Suppose t :: GenTree a, then reflect (reflect t) = t 
  Proof is by Induction on t.

  Base Case: t = GenLeaf
    Left Side: reflect (reflect GenLeaf) = reflect (GenLeaf) = GenLeaf
    Right Side: GenLeaf

  Inductive Case: 
    Suppose t = GenNode val [l1, ..., ln] [r1, ..., rn]
    Inductive Hypothesis: reflect (reflect foo) = foo where foo = l1 ... ln, r1 ... rn
    i.e. each individual tree itself is flipped correctly

   Left Side: 
      reflect (reflect (GenNode val [l1...ln] [r1...rn]))
    = reflect (GenNode val (flipsub right) (flipsub left))
    = GenNode val (flipsub (flipsub left)) (flipsub (flipsub right))
    = GenNode val left right          (have to prove that flipsub (flipsub x) = x)

   Proof is by induction on x, which is a list of trees
   Base Case: x = []
     Left Side: flipsub (flipsub [])
              = fipsub (reverse .  map reflect [])
              = flipsub (reverse [])
              = flipsub []
              = reverse . map reflect []
              = reverse [] = []
    Right side: []

   Inductive Case: xs = t:ts 
    Inductive Hypothesis: flipsub (flipsub ts) = ts
          (also need inductive hypothesis from reflect)
    Left Side: flipsub (flipsub (t:ts)) 
            =  flipsub (reverse . map reflect (t:ts))
            =  flipsub (reverse . ((reflect t) : map reflect ts))
            =  flipsub ((map reflect ts) ++ [reflect t])
            =  reverse (map reflect ((map reflect ts) ++ [reflect t]))
            =  reverse ((map reflect (map reflect ts)) ++ (map reflect [reflect t])
            =  (map reflect [reflect t]) ++ (map reflect (map reflect ts))
            =  reflect (reflect t) : (map reflect (map reflect ts))   (since [t] is a singleton list)
            = t : reverse (reverse (map reflect (map reflect ts))) (since reverse (reverse x) is x)
            = t : reverse (map reflect (reverse (map reflect ts))) (since reverse (map f xs) = map f (reverse xs))
            = t : flipsub (flipsub ts)
            = t : ts (by inductive hypothesis)
            = xs

--------------------------------------------------------------------------------
Theorem : length (inorder t) = size t, where t :: GenTree a

Proof is by induction on t

Base Case: t = GenLeaf
   Left Side = length (inorder GenLeaf)
             = length []
             = 0
   Right Side = size GenLeaf
              = 0

Inductive Case: t = GenNode val x@[x1, ... , xn] y@[y1, ..., ym], where x_i, y_i :: GenTree a, val :: a
Inductive Hypothesis: length (inorder x_i) = size x_i
                      length (inorder y_i) = size y_i forall i
 
Left Side = length (inorder t)
           = length (inorder GenNode val x y)
           = length (inorder' x ++ [val] ++ inorder' y)
           = length ((concat . map inorder x) ++ [val] ++ (concat . map inorder y))
           = length (concat . map inorder x) + 1 + length (concat . map inorder y)
           = sum (map (length . inorder) x) + 1 + sum (map (length . inorder) y)  (since length (concat xs) = sum (map length) xs, and map f (map g xs) = map (f . g) xs)
           = sum ([size x_1, ..., size x_n])  + 1 + sum ([size y_1, ..., size y_n])
           = SUM size x_i + 1 + SUM size y_i

Right Side = size (GenNode val x@[x1, ..., xn] y@[y1, ... ym])
           = 1 + sumsub x + sumsub y
           = 1 + (sum (map size x)) + (sum (map size y))
           = 1 + (sum [size x_1, ... , size x_n])  + (sum [size y_1, ..., y_n])
           = 1 + SUM size x_i + SUM size y_i

-}

-- =============================================================================
-- 5.5 Improving Execution Time

{- Timing Analysis of Functions
Use equational reasoning to deduce how long a function would take

e.g. inorder

1. time (inorder GenLeaf) = 0 (simplifying assumption, small amount of time taken to return the empty list)

2. time (inorder (GenNode root left right))
   = time (inorder' left ++ [root] ++ inorder' right)

How long does ++ take?
Do equational reasoning on definition of ++
get: time (xs ++ ys) = length xs

So, time (inorder' left ++ [root] ++ inorder' right)
    = length (inorder' left) + 1 + time (inorder' left) + time (inorder' right)
    = 1 + length (concat (map inorder left))  + time (concat (map inorder left))  + time (concat (map inorder right))
    = 1 + sum (map length (map inorder left))) + time (concat (map inorder left)) + time (concat (map inorder right))  [since length (concat xs) = sum (map length xs)]
    = 1 + sum (map (length . inorder) left) + time (concat (map inorder left)) + time (concat (map inorder right))
    = 1 + SIZE_left + time (concat (map inorder left)) + time (concat (map inorder right))
    = 1 + SIZE_left + (time to concatenate inorder results + time to traverse each left subtree) + (time to concatenate inorder results + time to traverse  each right subtree)
    ~ 1 + SIZE_left + (SIZE_left + TIME_left) + (SIZE_right + TIME_right)  [approximately equal because concatenation time is overestimated; we don't need to spend time proportional to the last child in the list, but we're still adding that for simplicity]
    = 1 + 2 * SIZE_left + TIME_left + TIME_right

(Does the above make sense? Where do we get 2 * SIZE_left from? One is from when we're building the list corresponding to the tree (time taken is approximately SIZE_left). Then we need to add this list in front of the list from the right subtree, so another SIZE_left there.

 ** This is a recurrence equation **
Problem Case for our function: when the lists are left-heavy.
-}

-- =============================================================================
-- 5.6 Flattening Trees in Linear Time

-- Reason that inorder is slow is that it recopies the list repeatedly as it concatenates
-- Trick: accumulate the result list in a collection of partial computations
--        that permit pasting the results directly, avoiding costly concatenations
-- The partial list is called a continuation

-- second argument is the continuation
inorderLinear :: GenTree a -> [a] -> [a]
inorderLinear GenLeaf ks = ks
inorderLinear (GenNode val left right) ks = inorderLinear' left (val : (inorderLinear' right ks))
  where inorderLinear' :: [GenTree a] -> [a] -> [a]
        inorderLinear' [] ks = ks
        inorderLinear' (x:xs) ks = inorderLinear x (inorderLinear' xs ks)

{- What is going on?
My version is more complicated than the book's because my left/right is a list of subtrees and not just a single subtree
So, I have two functions: one that performs traversal on a Tree, and another that does traversal on a list of trees. 

To traverse a single tree:
  1. If it is a leaf, then just perform the continuation
  2. If it is a Node, then traverse the list of subtrees in the left. Once done, show the value of the Node, and then traverse the list of subtrees in the right.

To traverse a list of trees (the reason I'm not simply mapping over, is that the continuation for the first subtree is traversing the list of rest of the subtrees; the continuation is to be applied only when the list is empty)

  1. If the list is empty, apply the continuation.
  2. If the list is not empty, traverse the first subtree, then traverse the list of rest of the subtrees.
-}

--------------------------------------------------------------------------------
{- Theorem: inorderLinear t ks = inorder t ++ ks, where t is a finite GenTree a, ks :: [a]
Proof is by structural induction on t

Base Case: t = GenLeaf
 Left Side: inorderLinear GenLeaf ks
          = ks
 Right Side; inorder GenLeaf ++ ks
          = [] ++ ks
          = ks

Inductive Case: t = GenNode val [left_1, ..., left_n] [right_1, ..., right_n]
  Inductive Hypothesis: inorderLinear left_i ks = inorder left_i ++ ks

Left Side: inorderLinear GenNode val left right
         = inorderLinear' left (val : inorderLinear' right ks)

 -- Lemma: inorderLinear' left ks = concat (map inorder left) ++ ks
    Proof is by induction on "left"
    Base Case: 
       Left Side: inorderLinear' [] ks = ks
       Right Side: concat (map inorder []) ++ ks
                 = concat [] ++ ks = [] ++ ks = ks

    Inductive Case: left = l:ls
      Hypothesis: inorderLinear' ls ks = concat (map inorder ls) ++ ks
     
      Left Side: inorderLinear' (l:ls) ks
               = inorderLinear l (inorderLinear' ls ks)
               = inorderLinear l (concat (map inorder ls) ++ ks)
               = inorder l ++ (concat (map inorder ls) ++ ks)  [ Assuming inorderLinear works]
               = (concat (inorder l):(map inorder ls) ++ ks)
               = concat (map inorder l:ls) ++ ks
               QED

  -- back to the original theorem:
           inorderLinear' left (val : inorderLinear' right ks)
         = concat (map inorderLin left) ++ (val : inorderLinear' right ks) (by Lemma)
         = concat (map inorderLin left) ++ (val : (concat (map inorderLin right) ++ ks)
         = concat (map inorderLin left) ++ [val] ++ (concat (map inorderLin right) ++ ks)
         = inorder' left ++ [val] ++ inorder' right ++ ks
         = inorder  t ++ ks
QED
            
ASIDE: Question about the soundness of the proof
The problem is that inorder needs to assume that inorder' works, which in turn needs to assume that inorder works.

The inductive hypothesis for inorder' states that it works for ls in the (l:ls) part
The inductive hypothesis for inorder states that it works for the subtrees of the node i'm currently looking at.

So, when i'm in inorder' and I assume that inorder works, I'm assuming that it works for an element, A,  in a particular tree. Now I'm in inorder and I need to know if inorder works for A. But inorder works for A if inorder' works for lA and lB, which are left and right children of A. but these are "smaller" in a sense than the original list that inorder' was looking at. So by the inductive hypothesis for inorder', inorder' DOES work for lA and lB, so inorder DOES work for A. 

This is why the assumption is justified.
-}

--------------------------------------------------------------------------------
{- Theorem: time (inorderLinear t []) = size t , where t is a finite tree.
Proof is by structural induction on the tree

time (inorderLinear GenLeaf []) = 0  (since we just need to return a value)

time (inorderLinear (GenNode val left right) [])
= time (inorderLinear' left (val : (inorderLinear' right [])))

  How much time to do inorderLinear' t [] ?
    Claim: it is sum (map size t)  aka grand size of t
  Induction on t:
     When t = [], we just return a value so 0
     When t = x:xs, 
        time (inorderLinear x (inorderLinear' xs []))
        = time (inorderLinear x) + time (inorderLinear' xs [])
        = time (inorderLinear x) + sum (map size xs)
        = size x + sum (map size xs)    [ ASSUMING inorderLinear's timing done correctly]
        = sum (map size x:xs) which proves our hypothesis

back to the original problem:
= time (inorderLinear' left (val : (inorderLinear' right [])))
= sum (map size left) + 1 + sum (map size right)   [ + 1 is for consing val onto a list]
= size t
-}

--------------------------------------------------------------------------------
-- Ex 12: Write appendTree, a function that takes a binary tree and a list
-- and appends the contents of the tree, traversed left to right to the front of the list
-- Try to find an efficient solution that minimizes recopying.

appendTree :: GenTree a -> [a] -> [a]
appendTree t ks = inorderLinear t ks