PIH - ch10 - 1/3 - Declaring types and classes

PIH - ch10 - 1/3 - Declaring types and classes - exercises

by @ardumont on 27 Apr 2013

Here are the first parts of the chapter 10 of the book Programming in Haskell.

Natural

Using recursion and the function add, define a multiplication function mult :: Nat -> Nat -> Nat for natural numbers.

Recall:

data Nat = Zero | Succ Nat deriving Show

add :: Nat -> Nat -> Nat
add Zero m     = m
add (Succ n) m = Succ (add n m)

Now, the base cases of multiplication, anything that multiplies Zero renders Zero:

mult Zero _        = Zero

The recursivity lies in decomposing the multiplication into multiple additions:

n*m = m + (n-1) * m
    = m + m + (n-2) * m
    = 2m + (n-2) * m
    = ...
    = (m + m + m + ... + m) + 0 * m

This is expressed:

mult :: Nat -> Nat -> Nat
mult Zero _        = Zero
mult (Succ n) m    = add m $ mult n m

Examples:

*Nat> mult Zero Zero
Zero
*Nat> mult Zero (Succ Zero)
Zero
*Nat> mult (Succ Zero) (Succ Zero)
Succ Zero
*Nat> mult (Succ Zero) (Succ (Succ Zero))
Succ (Succ Zero)
*Nat> mult (Succ (Succ Zero)) (Succ (Succ Zero))
Succ (Succ (Succ (Succ Zero)))
*Nat> mult (Succ (Succ (Succ Zero))) (Succ (Succ Zero))
Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero)))))))
*Nat> nat2int $ Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero)))))))
8

Redefine occurs

compare

Although not included in appendix A, the standard library defines data Ordering = LT | EQ | GT together with a function compare :: Ord a => a -> a -> Ordering. This decides if one value in an ordered type is less than LT, equal to EQ, or greater than GT another such value. Using this function, redefine the function occurs :: Int -> Tree -> Bool for search trees.

Here are some example on how to use the compare function:

1 < 2:

*Tree2> compare 1 2
LT

1 < 2:

*Tree2> compare 2 1
GT

2 == 2:

*Tree2> compare 2 2
EQ

Here the current type Tree:

data Tree a = Leaf a | Node (Tree a) a (Tree a) deriving Show

The current implementation of the search Tree:

occursST :: Ord a => Tree a -> a -> Bool
occursST (Leaf n)     m = m == n
occursST (Node l n r) m | m == n    = True
                        | m < n     = occursST l m
                        | otherwise = occursST r m

We can then synthesize the comparison computation in the occurs function like this:

occursST2 :: Ord a => Tree a -> a -> Bool
occursST2 (Leaf n) m     = n == m
occursST2 (Node l n r) m = case (compare m n) of
  EQ -> True
  LT -> occursST2 l m
  GT -> occursST2 r m

Performance

Why is this new definition more efficient than the original version?

In the previous version, we did at most 2 comparisons for each node, in this one, we do it only once.

Binary Tree

Consider the following type of binary trees: data Tree = Leaf Int | Node Tree Tree Let us say that such a tree is balanced if the number of leaves in the left and right subtree of every node differs by at most one, with leaves themselves being trivially balanced. Define a function balanced :: Tree -> Bool that decides if a tree is balanced or not.

Hint: first define a function that returns the number of leaves in a tree.

First, we need a function to compute the number of leaves of a Tree:

nbLeaves :: Tree -> Int
nbLeaves (Leaf _) = 1
nbLeaves (Node l r) = nbLeaves l + nbLeaves r

Example:

*Tree2> nbLeaves $ Node (Node (Leaf 1) (Leaf 3)) (Node (Leaf 5) (Leaf 7))
4

Now the balanced function, first its type:

balanced :: Tree -> Bool

Second, the base case; a leaf is trivially balanced:

balanced (Leaf _) = True

By computing the number of leaves for each branch, we can compute the difference which does not be superior to 1:

balanced (Node l r) = let nl = nbLeaves l
                          nr = nbLeaves r in
                      abs (nl - nr) <= 1 &&

Also, the tree l and r must be balanced:

balanced l &&
balanced r

Enough with the speach already!!! Ok, here we go:

balanced :: Tree -> Bool
balanced (Leaf _) = True
balanced (Node l r) = let nl = nbLeaves l
                          nr = nbLeaves r in
                      abs (nl - nr) <= 1 &&
                      balanced l &&
                      balanced r

Balance

Define a function balance :: [Int] -> Tree that converts a non-empty list of integers into a balanced tree.

Hint: First define a function that splits a list into two halves whose length differs by at most one.

First a function to split a list, we'll simply split a list at length divided by 2:

split :: [a] -> ([a], [a])
split l = splitAt n l where n = (length l) `div` 2

Examples:

*Tree2> split [1..11]
([1,2,3,4,5],[6,7,8,9,10,11])
*Tree2> split [1]
([],[1])
*Tree2> split [1,2]
([1],[2])
*Tree2> split [1,2,3]
([1],[2,3])

Here is the type:

balance :: [Int] -> Tree

The base case:

balance [x]     = Leaf x

Last, we split the list in two well balanced list, then we dispatch the building of the list:

balance :: [Int] -> Tree
balance [x]     = Leaf x
balance ls = let (l, r) = split ls in Node (balance l) (balance r)

*Tree2> map balanced (map balance [ [1..i] | i <- [1..10] ])
[True,True,True,True,True,True,True,True,True,True]
*Tree2> map balanced (map balance [ [1..i] | i <- [1..100] ])
[True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True]

All tree must be balanced, so the result of this snippet must be []

*Tree2> filter (== False) (map balanced (map balance [ [1..i] | i <- [1..1000] ]))
[]