module Trees where

import Char

----------

data BTree a   = Tip    | BNode a (BTree a)   (BTree a)      deriving (Eq, Ord, Show)

data LTree a b = Leaf a | Node  b (LTree a b) (LTree a b)    deriving (Eq, Ord, Show)


--

size    Tip = 0
size   (BNode x l r) = 1 + size l + size r

height  Tip = 0
height (BNode x l r) = 1 + max (height l) (height r)



tmap f  Tip = Tip
tmap f (BNode x l r) = BNode (f x) (tmap f l) (tmap f r)

inord   Tip = []
inord  (BNode x l r) = inord l ++ x : inord r

preord  Tip = []
preord (BNode x l r) = x : preord l ++ preord r

--

fold f u  Tip = u
fold f u (BNode x l r) = f x (fold f u l) (fold f u r)

size'   = fold  (\x l r -> 1 + l + r)    0
height' = fold  (\x l r -> 1 + max l r)  0
tmap' f = fold  (BNode . f) Tip
inord'  = fold  (\x l r -> l ++ x : r)  []
preord' = fold  (\x l r -> x : l ++ r)  []
mirror  = fold  (flip . BNode)  Tip


--

draw p Tip = line p "."
draw p (BNode x l r) = draw p' r ++ line p (show x) ++ draw p' l
                       where p' = '\t' : p

line p s = p ++ s ++ "\n"

outln t = putStrLn (draw "" t)

sample = BNode 'A' (BNode 'B' (leaf 'C')
                              (leaf 'D'))
                   (BNode 'E' (BNode 'F' (leaf 'G') Tip)
                              (BNode 'H' (BNode 'I' Tip (leaf 'J'))
                                         (leaf 'K')))

----------

data Rose a = Branch a [Rose a]     deriving (Eq, Ord, Show)

root (Branch a _ ) = a
kids (Branch _ ks) = ks

twig x = Branch x []

unfold :: (b -> Bool) -> (b -> a) -> (b -> b) -> b -> [a]
unfold p f g x= if p x then [] else f x : unfold p f g (g x)

levord = concat . unfold null (map root) (concatMap kids) . (:[])

tree = Branch 1 [	Branch 2 [Branch  6  [twig 11, 
                                          twig 12], 
                              twig    7], 
                	Branch 3 [],
                	Branch 4 [Branch  8  [twig 13, 
                	                      twig 14], 
                	          twig    9, 
                	          Branch 10  [twig 15]],
                	twig   5 ]

----------

leaf x = BNode x Tip Tip

insert x Tip = leaf x
insert x (BNode y l r) = if x < y then BNode y (insert x l) r
                                  else BNode y l (insert x r)

build xs = foldl (flip insert) Tip xs

tsort xs  = inord (build xs)

----------

isort xs = foldr ins [] xs

ins x [] = [x]
ins x (y:ys) = if x < y then x : y : ys else y : ins x ys

--

qsort [] = []
qsort (x:xs) = rec (<) ++ x : rec (>=)
               where rec op = qsort (filter (`op` x) xs)

--

merge xs [] = xs
merge [] ys = ys
merge xs@(x:xs') ys@(y:ys') = if x < y then x : merge xs' ys
                                       else y : merge xs ys'

split []  = ([], [])
split [x] = ([x],[])
split (e:o:xs) = (e:es, o:os) where (es,os) = split xs

msort []  = []
msort [x] = [x]
msort xs@[x,y] = if x < y then xs else [y,x]			-- worth about 5%
msort xs = merge (msort ys) (msort zs) where (ys,zs) = split xs

--

test = filter (/= ' ') "the quick brown fox jumps over the lazy dog"
bigtest = take 1000 (cycle test)

----------

type AExpr = Expr Integer AOpr

data Expr a b  = Lit a  | Bop b (Expr a b) (Expr a b)     deriving (Eq, Ord, Show)

folde f g (Lit n)     = f n
folde f g (Bop o l r) = g o (folde f g l) (folde f g r)

--

data AOpr = Add | Sub | Mul    deriving Eq

folda a s m Add = a
folda a s m Sub = s
folda a s m Mul = m

instance Show AOpr where
  show = folda "+" "-" "*"
  
--

prfx exp = folde show (\o l r -> unwords  [show o,l,r]) exp
pofx exp = folde show (\o l r -> unwords  [l,r,show o]) exp
infx exp = folde show (\o l r -> parwords [l,show o,r]) exp

parwords s = concat ["(", unwords s, ")"]

--

sema = folda (+) (-) (*)

eval = folde id sema

[(!+),(!-),(!*)] = map Bop [Add,Sub,Mul]

expr = Bop Add (Bop Sub (Lit 6) (Lit 4))
               (Bop Mul (Lit 3) (Lit 5))

expr' = (Lit 1 !+ Lit 2) !* ((Lit 6 !- Lit 4) !+ (Lit 3 !* Lit 5))

--

dispeq = ("   "++) . foldr1 (\x y -> x++"\n = "++y)

comb op ls@(l:_) (r:tr) = let (&) = Bop op in
  Lit (eval (l&r)) : map (&r) ls ++ map (last ls &) tr

trace = folde ((:[]) . Lit) comb

calc = putStr . dispeq . map infx . reverse . trace

----------