Functional Programming
Sheet 7
25/11/03
> module Sheet7 where
Question 3
> head' :: [a] -> a
> head' (x:_) = x
> data Liste a = Nil | Snoc (Liste a) a
> head'' :: Liste a -> a
> head'' (Snoc Nil x) = x
> head'' (Snoc xs _) = head'' xs
> convert' :: Liste a -> [a] -> [a]
> convert' Nil = id
> convert' (Snoc xs x) = convert' xs . (x:)
> convert :: Liste a -> [a]
> convert xs = convert' xs []
Technique Acknowledgement:
http://www.haskell.org/hawiki/ListMutation
Question 4
> data Btree a = Tip a | Node (Btree a) (Btree a)
(a)
> subtrees :: Btree a -> [Btree a]
> subtrees (Tip n) = [Tip n]
> subtrees (Node t1 t2) = Node t1 t2:(subtrees t1 ++ subtrees t2)
------------------------------------------------
FOR REFERENCE PURPOSES:
size :: Btree a -> Int
size (Tip _) = 1
size (Node left right) = size left + size right
------------------------------------------------
In general, a tree of size n has (2n - 1) subtrees.
Proof:
First of all, here's an informal proof. A tree of size 1 has a single subtree (itself). To get from a tree of size n to
a tree of size (n+1), we replace a Tip with a Node with a Tip as each of its subtrees. This increases the number of
subtrees by 2 (since each of the two Tips is a subtree and there is still a subtree rooted at the Node). Thus there are
clearly (2n + c) subtrees of a tree of size n, for some c. Since a tree of size 1 has 1 subtree, c = -1, hence there are
(2n - 1) subtrees of a tree of size n.
We will now prove this formally by induction:
[Base Case]
length (subtrees (Tip n))
= length [Tip n] {defn. of subtrees}
= 1 {defn. of length}
= 2 * 1 - 1 {by arithmetic}
= 2 * (size (Tip n)) - 1 {defn. of size}
QED
[Inductive Hypothesis]
There exist subtrees of t - left, right - s.t.
length (subtrees left) = 2 * (size left) - 1 and length (subtrees right) = 2 * (size right) - 1 [hyp]
[Inductive Step]
Show that [hyp] => length (subtrees (Node left right)) = 2 * size (Node left right) - 1
length (subtrees (Node left right))
= length (Node left right:(subtrees left ++ subtrees right)) {defn. of subtrees}
= 1 + length (subtrees left ++ subtrees right) {defn. of length}
= 1 + length (subtrees left) + length (subtrees right) {by the expected length and (++) relation}
= 1 + 2 * (size left) - 1 + 2 * (size right) - 1 {by [hyp]}
= 2 * (size left + size right) - 1 {by arithmetic}
= 2 * size (Node left right) - 1 {defn. of size}
QED
(b)
> mapBtree :: (a -> b) -> Btree a -> Btree b
> mapBtree f (Tip n) = Tip (f n)
> mapBtree f (Node t1 t2) = Node (mapBtree f t1) (mapBtree f t2)
> foldBtree :: (b -> b -> b) -> (a -> b) -> Btree a -> b
> foldBtree _ g (Tip n) = g n
> foldBtree f g (Node t1 t2) = f (foldBtree f g t1) (foldBtree f g t2)
---
> unfoldBtree :: (b -> (b,b)) -> (b -> a) -> (b -> Bool) -> b -> Btree a
> unfoldBtree f g h x
> | h x = Tip (g x)
> | otherwise = Node t1 t2
> where
> (m,n) = f x
> (t1,t2) = (unfoldBtree f g h m, unfoldBtree f g h n)
Comment: I'm not sure whether this is what you had in mind for unfold on a tree? Here's an example of how this version works, at any rate:
unfoldBtree (\(x:xs) -> ([x],xs)) head (\xs -> length xs == 1) [1..4]
= Node (Tip 1) (Node (Tip 2) (Node (Tip 3) (Tip 4)))
---
Folds/Related things, for other types of binary tree:
i) A binary tree with values at the nodes as well as the leaves
> data BtreeB a = Leaf a | NodeB a (BtreeB a) (BtreeB a)
> mapBtreeB :: (a -> b) -> BtreeB a -> BtreeB b
> mapBtreeB f (Leaf n) = Leaf (f n)
> mapBtreeB f (NodeB n left right) = NodeB (f n) (mapBtreeB f left) (mapBtreeB f right)
> foldBtreeB :: (b -> b -> b -> b) -> (a -> b) -> BtreeB a -> b
> foldBtreeB _ g (Leaf n) = g n
> foldBtreeB f g (NodeB n left right) = f (foldBtreeB f g left) (g n) (foldBtreeB f g right)
ii) An expression tree evaluator - has some similarities to folding a tree
> data Etree a = Operand a | BinaryOp (a -> a -> a) (Etree a) (Etree a)
> evaluate :: Etree a -> a
> evaluate (Operand n) = n
> evaluate (BinaryOp f left right) = f (evaluate left) (evaluate right)
(c)
> tips :: Btree a -> [a]
> tips (Tip x) = [x]
> tips (Node u v) = tips u ++ tips v
> tips' :: Btree a -> [a]
> tips' = foldBtree (++) (\x -> [x])
In the worst case, the running time of tips is O(n^2). Consider the perfectly unbalanced tree:
Node (Node (Node (Tip 1) (Tip 2)) (Tip 3)) (Tip 4)
Then we have:
tips (Node (Node (Node (Tip 1) (Tip 2)) (Tip 3)) (Tip 4))
= tips (Node (Node (Tip 1) (Tip 2)) (Tip 3)) ++ tips (Tip 4)
= tips (Node (Node (Tip 1) (Tip 2)) (Tip 3)) ++ [4]
= (tips (Node (Tip 1) (Tip 2)) ++ tips (Tip 3)) ++ [4]
= (tips (Node (Tip 1) (Tip 2)) ++ [3]) ++ [4]
= ((tips (Tip 1) ++ tips (Tip 2)) ++ [3]) ++ [4]
= (([1] ++ [2]) ++ [3]) ++ [4]
= ((1:([] ++ [2])) ++ [3]) ++ [4]
= (1:[2] ++ [3]) ++ [4]
= (1:([2] ++ [3])) ++ [4]
= (1:(2:([] ++ [3]))) ++ [4]
= 1:2:[3] ++ [4]
= 1:(2:[3] ++ [4])
= 1:(2:([3] ++ [4]))
= 1:(2:(3:([] ++ [4])))
= 1:2:3:[4]
= [1,2,3,4]
which is O(n^2).
(d)
> tipslist :: Btree a -> [a] -> [a]
> tipslist (Tip x) = (x:)
> tipslist (Node u v) = tipslist u . tipslist v
> tips'' :: Btree a -> [a]
> tips'' t = tipslist t []
The running time of this should now be O(n), since we'll just end up doing something like:
((1:) . (2:) . (3:) . (4:)) []
and (:) is a constant-time operation.
Question 5
> data Path = None | Just [Dir]
> deriving Eq
> data Dir = Left | Right
> deriving Eq
> findpath :: Eq a => Btree a -> a -> Path
> findpath (Tip n) x
> | n == x = Just []
> | otherwise = None
> findpath (Node t1 t2) x
> | leftPath == None = rightPath
> | otherwise = leftPath
> where
> pushfront :: Dir -> Path -> Path
> pushfront _ None = None
> pushfront d (Just p) = Just (d:p)
>
> leftPath = pushfront Left (findpath t1 x)
> rightPath = pushfront Right (findpath t2 x)
Question 6
It takes theta (phi ^ n) operations to evaluate fib n, where phi = (1 + sqrt 5) / 2. (See Bird P.235)
fib n = fst (twoFibs n) (= snd (twoFibs (n-1)) for n >= 1)
fib 0 = fst (twoFibs 0) = 1
fib 1 = fst (twoFibs 1) = snd (twoFibs 0) = 1
Since fst (twoFibs 0) = fib 0 = 1 and snd (twoFibs 0) = fib 1 = 1:
twoFibs 0 = (1,1)
Now looking at twoFibs (n+1), we have:
twoFibs (n+1)
= (fib (n+1), fib (n+2)) {spec. of twoFibs}
= (fib (n+1), fib (n+1) + fib n) {defn. of fib}
= (snd (twoFibs n), snd (twoFibs n) + fst (twoFibs n)) {spec. of twoFibs}
Let (a,b) = twoFibs n.
Then:
twoFibs (n+1) = (b,a+b), where (a,b) = twoFibs n
The complete definition of twoFibs is therefore:
> twoFibs :: Integer -> (Integer,Integer)
> twoFibs 0 = (1,1)
> twoFibs (n+1) = (b,a+b)
> where (a,b) = twoFibs n
> fib :: Integer -> Integer
> fib = fst . twoFibs
Question 7
> twoPowers :: Integer -> Integer -> [(Integer,Integer)]
> twoPowers m 1 = [(m,1)]
> twoPowers m (n+1) = (((fst (head xs))^2),2*snd(head xs)):xs
> where xs = twoPowers m n
> power' :: Integer -> Integer -> [(Integer,Integer)] -> Integer
> power' _ 0 _ = 1
> power' m n tp
> | n >= snd (head tp) = fst (head tp) * power' m (n - snd (head tp)) tp
> | otherwise = power' m n (tail tp)
> power :: Integer -> Integer -> Integer
> power _ 0 = 1
> power m n = power' m n tp
> where tp = twoPowers m (floor ((log (fromInteger n) / log 2.0) + 1.0))