--
--   WE DON'T LOVE TREES YET [Part I]
--
--            ... and why all this folding?
--

data Tree a = Branch (Tree a) (Tree a)
            | Leaf a
   deriving (Show,Eq)

--
--  Example elements of the type Tree a are
--         Leaf a
--         Branch (Leaf a1) (Leaf a2)
--         Branch (Branch (Leaf a1) (Leaf a2)) (Leaf a3)
--         ...
--

--
-- Here is the fold for Tree with a function for the Branch
-- constructor, f_b, and a function, f_l, for the Leaf
-- constructor:
--
foldTree:: (c -> c -> c) -> (a -> c) -> (Tree a) -> c
foldTree f_b f_l (Leaf a) = f_l a
foldTree f_b f_l (Branch t1 t2)
     = f_b (foldTree f_b f_l t1) (foldTree f_b f_l t2)

--
-- To sum the leaves of a Tree of Integers
--
sumTree:: Tree Integer -> Integer
sumTree = foldTree (+) id

-- A common thing to want to do is to traverse the leaves of a tree.
-- A step to facilite this is to collect the leaves into a list:

collect:: Tree a -> [a]
collect = foldTree (++) (\x -> [x])

------------------------------------------------------------------------
--              This brings up some COMPLEXITY THOUGHTS
--
--  The complexity of this collect is determined by the complexity of
--  (++) which, in turn, is determined by the size of its first argument.
--  Thus consider a tree of uniform depth d (which will have 2^d leaves and
--  2^d-1 branch nodes) then a node at depth r will have to append two lists
--  of length 2^(d-r) however there are 2^r of these nodes. Thus the work
--  done at each level is 2^(d-r) * 2^r = 2^d/2 and there are d-1 level 
--  of nodes.  Thus the cost of the computation is d * 2^d.
-- 
--  Finally setting the size of the tree, n, to be the number leaves
--  then cost of the computation is n * (log n)  which is not bad.
--
--  However if the tree is skewed to the left (so all right branches
--  are leaves) then the cost of the computation becomes
--             1+2+..+(n-1) = n*(n-1)/2
--  which is quadratic and not so good :-/
--
--  So the downside of this algorithm is that in the worst case it is
--  quadratic.
--
--  Can we do anything about this? In fact with a higher-order trick
--  we can reduce the complexity to O(n):

fcollect:: Tree a -> [a]
fcollect t = foldTree (.) (\a x -> a:x) t []

-- Here the operation at each noode of the tree is composition of functions
-- which is a constant time operation (so complexity O(n)). The last step
-- is to evaluate this sequence of compositions of functions on the
-- empty list [] (complexity O(n)). So the whole has O(n) complexity!

--  (NB. Haskell program optimization can automatically catch this sort
--  of in efficency.)
------------------------------------------------------------------------

--
-- The success or fail datatype (again)
data SF a = SS a| FF
    deriving (Show,Eq)

mapsf:: (a->b) -> (SF a) -> (SF b)
mapsf f (SS a) = SS (f a)
mapsf _ FF = FF

sflist:: [SF a] -> (SF [a])
sflist = foldr (\a as -> case (a,as) of
                              (SS x, SS xs) -> SS (x:xs)
                              _ -> FF)
               (SS [])

--------------------------------------------
--
-- The datatype of expressions:
--
--------------------------------------------

data Exp f v  = Opn f [Exp f v]
              | Var v
    deriving (Show,Eq)

-- Typical elements of (Exp String Integer) are
--         Var 3
--         Opn "add" [Var 2,Var 3,Var 4]
--         Opn "div  [Var 7, Opn "add" [Var 9,Var 7]]
--         Opn "p" [Opn "q" [],Opn "r" [Var 6, Opn "s" []]]
--         ..
-- We think of this as an abstract "expression" with opperation names
-- "p", "q", "r" acting on arguments

--
-- Here is the fold for the datatype (note the use of the map
-- to get inside the arguments!
--
foldExp:: (f -> [c] -> c) -> (v -> c) -> (Exp f v) -> c
foldExp opn var (Var v) = var v
foldExp opn var (Opn f args) = opn f (map (foldExp opn var) args)

--
-- To illustrate how we may view this as an expression
-- suppose we  have operations of addition and multiplication
-- Then we can "evaluate" an expression of integers

data Operations = Add | Mult
    deriving (Show,Eq)

evaluate:: Exp Operations Integer -> Integer
evaluate = foldExp (\x -> case x of
                               Add -> foldl (+) 0
                               Mult -> foldl (*) 1)
                   id

-------------------------------------------------
--
--              MATCHING
--
--    We have already met the idea of matching in hand evaluating
-- Haskell programs.  However, we can actually program it!!
-- The idea is given two expression trees the second of which
-- we view as a template we can find the substitutions of the
-- variables in the second tree in order to reconstruct the
-- first tree.  Of course, matching may fail ...  so we shall
-- return a success or fail of a list of substitutions.
--
-- Here is the basic matching program:

match:: (Eq f) => (Exp f v) -> (Exp f w) -> (SF [(w,Exp f v)])
match t (Var v) = SS [(v,t)]
match (Opn f1 args1) (Opn f2 args2)
   | f1==f2 && (length args1 == length args2)
           = mapsf concat
             (sflist (map (\(t1,t2) -> match t1 t2) (zip args1 args2)))
   | otherwise = FF

--  Try this out on
--      match (Opn "f" [Opn "g" [],Opn "h" [Var 3,Var 4],Var 5])
--            (Opn "f" [Var "x",Var"y"])
--  then try
--      match (Opn "f" [Opn "g" [],Opn "h" [Var 3,Var 4],Var 5])
--            (Opn "f" [Var "x",Var"y",Var "z"])
--  What happened?
--
-- Now there is a another wrinkle to pattern matching
-- (as opposed to match ching) which is that the
-- template must not have repeated variables ...
-- we really should check for this!!
-- We can do so in two steps
--   (1) Obtain a list of variable
--   (2) check that the list is not repeating
-- Now (1) can be achieved very simply using a fold:

collectvar:: Exp f v -> [v]
collectvar = foldExp (\f vargs -> concat vargs) (\x -> [x])

-- For (2) we have

nonrepeating:: Eq a => [a] -> Bool
nonrepeating (a:as) = (nonrepeating as) && not (member a as)
    where member a [] = False
          member a (b:bs)| a==b = True
                         | otherwise = member a bs
nonrepeating [] = True

-- Note that this test is quadratic: every (unordered) pair of
-- elements of the list must be compared.

-- So now we can put this together into a "pattern matching"

pmatch:: (Eq f,Eq v,Eq w) => (Exp f v) -> (Exp f w) -> (SF [(w,Exp f v)])
pmatch t template| nonrepeating (collectvar template) = match t template
                 | otherwise = FF

-- This time pattern matching also fails if one does not have a "legal"
-- template!
--
--  Try this out on
--      match (Opn "f" [Opn "g" [],Opn "h" [Var 3,Var 4],Var 5])
--            (Opn "f" [Var "x",Var "x"])