{-
Long lecture on folds, reverse, data structures and efficiency
--------------------------------------------------------------
The plan:
* reminders on fold (for lists): definition, type, constr repl
* reminders on prior list functions
* prior list functions as folds
* folds as interspersion
* definition of foldl (or lfold)
* the reverse function (wrong way)
* efficient reverse using "an extra stack"
* generalizing from reverse: accumulating fold
* acc fold as foldl in disguise
* ASIDE: lambda notation
* acc fold as a higher-order fold (function result)
* data structure: binary leaf/node trees
* expression trees as a sample
* some functions on trees
* folds for trees
* tree-printing: the efficiency issue
* accumulating folds for trees
-}
-----------------------------------------------------------
-- Section 1: fold
-- our friend fold
fold :: (a -> b -> b) -> b -> [a] -> b
fold f u [] = u
fold f u (x:xs) = f x (fold f u xs)
-- prior functions on lists
len [] = 0
len (_:xs) = 1 + len xs
summ [] = 0
summ (n:ns) = n + sum ns
mapp f [] = []
mapp f (x:xs) = f x : mapp f xs
philter p [] = []
philter p (x:xs) = (if p x then (x:) else id) (philter p xs)
-- prior functions as folds
len' = fold (const (1+)) 0
sum' = fold (+) 0
map' f = fold ((:) . f) []
fil' p = fold opt []
where opt x = if p x then (x:) else id
-- folds as interspersion
-- fold (+) 0 [1 .. n] = (1 + (2 + ... (n + 0) ...))
-- fold (*) 1 [1 .. n] = (1 * (2 * ... (n * 1) ...))
-- fold f u [x1, ..., xn] = (x1 `f` (x2 `f` ... (xn `f` u) ...))
-- fold f u [x1, ..., xn] = (f x1 (f x2 ... (f xn u) ...))
-- folding from the left
-- fold (+) 0 [1 .. n] = (( ... (0 + 1) + ... n-1) + n)
-- fold (*) 1 [1 .. n] = (( ... (1 * 1) * ... n-1) * n)
-- fold f u [x1, ..., xn] = (( ... (u `f` x1) `f` ... xn-1) `f` xn)
-- fold f u [x1, ..., xn] = (f (f ( ... (f u x1) ... xn-1) xn)
lfold :: (b -> a -> b) -> b -> [a] -> b
lfold f a [] = a
lfold f a (x:xs) = lfold f (f a x) xs
-----------------------------------------------------------
-- Section 2: reverse
rev0 [] = []
rev0 (x:xs) = rev0 xs ++ [x]
rev1 xs = rh [] xs
where rh a [] = a
rh a (x:xs) = rh (x:a) xs
rev2 = rh []
where rh a [] = a
rh a (x:xs) = rh (x:a) xs
fl f r = fh r
where fh a [] = a
fh a (x:xs) = fh (f x a) xs
rev3 = fl (:) []
fl' f r [] = r
fl' f r (x:xs) = fl' f (f x r) xs
rev4 = fl' (:) []
rev5 = flip rh []
where rh [] a = a
rh (x:xs) a = rh xs (x:a)
rev6 = flip rh []
where rh [] = (\a -> a)
rh (x:xs) = (\a -> rh xs (x:a))
rev7 = flip rh []
where rh [] = id
rh (x:xs) = rh xs . (x:)
rev8 = flip (fl (:)) []
where fl f [] = id
fl f (x:xs) = fl f xs . f x
test r = and [r xs == reverse xs | xs <- tests]
where tests = [ [], [1], [1,2], [1..10], [1..1000] ]
-----------------------------------------------------------
-- Section 3: data structures
-- some variations on tree structure and a tree sort
data BTree a = Tip a | BNode (BTree a) (BTree a)
data BSTree a = Twig | Branch a (BSTree a) (BSTree a)
foldbs b t Twig = t
foldbs b t (Branch x l r) = b x (foldbs b t l) (foldbs b t r)
inorder = foldbs (\x l r -> l ++ x : r) []
ins x Twig = Branch x Twig Twig
ins x (Branch y l r) | x <= y = Branch y (ins x l) r
| otherwise = Branch y l (ins x r)
treesort :: Ord a => [a] -> [a]
treesort = inorder . foldr ins Twig
-- trees with internal nodes and external leaves (different types)
data Tree a b = Node a (Tree a b) (Tree a b) | Leaf b
deriving (Show, Eq)
expr = Node "+" (Node "*" (Leaf 2) (Leaf 3))
(Node "-" (Leaf 5) (Leaf 1))
prt1 (Leaf b) = show b
prt1 (Node a x y) = par (prt1 x ++ a ++ prt1 y)
par s = "(" ++ s ++ ")"
size (Leaf b) = 1
size (Node _ x y) = 1 + size x + size y
size2 (Leaf b) = (0,1)
size2 (Node _ x y) = (ln + rn + 1, ll + rl)
where (ln,ll) = size2 x
(rn,rl) = size2 y
depth (Leaf b) = 1
depth (Node _ x y) = 1 + (depth x `max` depth y)
foldt f g (Leaf b) = f b
foldt f g (Node a x y) = g a (foldt f g x) (foldt f g y)
size' = foldt (const 1) (\_ x y -> 1+x+y)
data Opr = Plus | Mult | Subr deriving (Show, Eq)
prop Plus = "+"; prop Mult = "*"; prop Subr = "-"
fun Plus = (+); fun Mult = (*); fun Subr = (-)
expr' = Node Plus (Node Mult (Leaf 2) (Leaf 3))
(Node Subr (Leaf 5) (Leaf 1))
prt3 :: Tree Opr Int -> String
prt3 = foldt show (\o x y -> par (x ++ prop o ++ y))
eval = foldt id (\o x y -> fun o x y)
eval' = foldt id fun