{-

	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