-- Lecture Notes 
-- Programming Languages and Types
 
-- October 22, 2009
-- Instructor: Sebastian Erdweg

-- Based on "Why functional programming matters" by John Hughes


module Main where

import Test.QuickCheck

-- factorial function
fact 0 = 1
fact n = n * fact (n - 1)


-- lists in haskell
emptyList = []
intList = [1,2,3,9,8,7]
consList = 1 : 2 : 3 : 9 : 8 : 7 : []
appendList = [1,2,3] ++ [9,8,7]
boolList = [True,False,False,True]
charList = ['a','b','z','y']


-- sum of integer list
--   structurally recursive
--   pattern matching
listsum [] = 0
listsum (i : k) = i + listsum k

-- product of integer list
--   structurally recursive
--   pattern matching
listprod [] = 1
listprod (i : k) = i * listprod k



-- generalize the definitions of listsum and listprod
-- to retrieve a more modular operation
reduce op init [] = init
reduce op init (i : k) = op i (reduce op init k)



-- define sum and prod in terms of reduce
listSumRed k = reduce (+) 0 k
listProdRed k = reduce (*) 1 k

-- quickly check whether the different versions of sum and
-- prod compute the same: quickCheck
testListSum k = listsum k == listSumRed k
testListProd k = listprod k == listProdRed k


-- reduce can be understood as follows:
--   all 'cons' cells are replaced by calls to 'op', and
--   'nil' (or '[]' for haskell) is replaced by 'init'.
-- 
-- accordingly, the following only copies the list
listCopy k = reduce (:) [] k


-- standard list concatenation
append [] ys = ys
append (x : xs) ys = x : (append xs ys)

-- using reduce again
appendRed xs ys = reduce (:) ys xs


-- quickly check whether the two versions of append compute the same
testAppend xs ys = append xs ys == appendRed xs ys


-- the map function on lists defined in terms of reduce
listMap f = reduce (\x ys -> f x : ys) []




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

-- single leaf
singleLeaf = Leaf 5

-- a tree
smallTree = Node
              (Leaf 4)
              (Node
                 (Node
                    (Leaf 3)
                    (Leaf 4))
                 (Leaf 6))



-- sum of all labels in tree
--   structurally recursive
--   pattern matching
treeSum (Leaf a) = a
treeSum (Node t1 t2) = treeSum t1 + treeSum t2

-- sum of all labels in tree
--   structurally recursive
--   pattern matching
treeProd (Leaf a) = a
treeProd (Node t1 t2) = treeProd t1 * treeProd t2



-- generalize again: one operation per constructor
reduceTree nodeOp leafOp (Leaf a) = leafOp a
reduceTree nodeOp leafOp (Node t1 t2) =
  nodeOp (reduceTree nodeOp leafOp t1)
         (reduceTree nodeOp leafOp t2)


-- tree sum and prod in terms of reduce
treeSumRed t = reduceTree (+) id t
treeProdRed t = reduceTree (*) id t



-- count leaves and nodes
countLeafs = reduceTree (+) (const 1)
countNodes = reduceTree ((+) . succ) (const 0)


-- all labels even?
allEven = reduceTree (&&) even


-- tree depth
depth = reduceTree (\l r -> succ (max l r)) (const 0)


-- list of occuring labels
allLabels = reduceTree append (\i -> [i])

-- check if label is contained by the tree
containsLabel a = reduceTree (||) (a ==)