module Sol7 where

import Data.List
import HL07IAR

-- | 7.14
-- >>>
subtr :: Natural -> Natural -> Natural
subtr Z _ = Z
subtr m Z = m
subtr (S m) (S n) = subtr m n

-- | 7.15
-- >>>
qrm :: Natural -> Natural -> (Natural, Natural)
qrm m n
  | gt n m = (Z, m)
  | otherwise = (S (fst qr), snd qr)
  where
    qr = qrm (subtr m n) n

quotient :: Natural -> Natural -> Natural
quotient m n = fst (qrm m n)

remainder :: Natural -> Natural -> Natural
remainder m n = snd (qrm m n)

-- | 7.16
-- >>>
pre :: Natural -> Natural
pre Z = Z
pre (S n) = n

subtr2 :: Natural -> Natural -> Natural
subtr2 = foldn pre

-- Did Haskell uset to allow this math on the left of = ?

-- | 7.20
-- >>>
--
-- catalan :: Integer -> Integer
-- catalan 0 = 1
-- catalan (n + 1) = sum [(catalan i) * (catalan (n - i)) | i <- [0 .. n]]

-- | 7.25
-- >>>
--
-- data TernTree = L' | N' TernTree TernTree TernTree deriving (Show)
--
-- makeTernTree :: Integer -> TernTree
-- makeTernTree 0 = L'
-- makeTernTree (n + 1) = N' (makeTernTree n) (makeTernTree n) (makeTernTree n)
--
-- count3 :: TernTree -> Integer
-- count3 L' = 1
-- count3 (N' t1 t2 t3) = 1 + count3 t1 + count3 t2 + count3 t3

-- | 7.28
-- >>>
insertTree :: Int -> Tree -> Tree
insertTree n Lf = (Nd n Lf Lf)
insertTree n t@(Nd m left right)
  | m < n = Nd m left (insertTree n right)
  | m > n = Nd m (insertTree n left) right
  | otherwise = t

-- | 7.29
-- >>>
list2tree :: [Int] -> Tree
list2tree [] = Lf
list2tree (n : ns) = insertTree n (list2tree ns)

tree2list :: Tree -> [Int]
tree2list Lf = []
tree2list (Nd n left right) = tree2list left ++ [n] ++ tree2list right

-- | 7.30
-- >>>
inTree :: Int -> Tree -> Bool
inTree n Lf = False
inTree n (Nd m left right)
  | n == m = True
  | n < m = inTree n left
  | n > m = inTree n right

-- | 7.31
-- >>>
mergeTrees :: Tree -> Tree -> Tree
mergeTrees t1 t2 = foldr insertTree t2 (tree2list t1)

-- | 7.32
findDepth :: Int -> Tree -> Int
findDepth _ Lf = -1
findDepth n (Nd m left right)
  | n == m = 0
  | n < m = if d1 == -1 then -1 else d1 + 1
  | n > m = if d2 == -1 then -1 else d2 + 1
  where
    d1 = findDepth n left
    d2 = findDepth n right

-- | 7.33
mapT :: (a -> b) -> Tr a -> Tr b
mapT f Nil = Nil
mapT f (T x left right) = T (f x) (mapT f left) (mapT f right)

-- | 7.34
foldT :: (a -> b -> b -> b) -> b -> (Tr a) -> b
foldT h c Nil = c
foldT h c (T x left right) = h x (foldT h c left) (foldT h c right)

-- | 7.35
preorderT, inorderT, postorderT :: Tr a -> [a]
preorderT = foldT preLists []
  where
    preLists x ys zs = (x : ys) ++ zs
inorderT = foldT inLists []
  where
    inLists x ys zs = ys ++ [x] ++ zs
postorderT = foldT postLists []
  where
    postLists x ys zs = ys ++ zs ++ [x]

-- | 7.36
orderedT :: (Ord a) => Tr a -> Bool
orderedT tree = ordered (inorderT tree)
  where
    ordered xs = (sort (nub xs) == xs)

-- | 7.37
lookupD :: String -> Dict -> [String]
lookupD _ Nil = []
lookupD x (T (v, w) left right)
  | x == v = [w]
  | x < v = lookupD x left
  | otherwise = lookupD x right

-- | 7.38
buildTree :: [a] -> Tr a
buildTree [] = Nil
buildTree xs = T m (buildTree left) (buildTree right)
  where
    (left, m, right) = split xs

-- | 7.39
mapLT :: (a -> b) -> LeafTree a -> LeafTree b
mapLT f (Leaf x) = Leaf (f x)
mapLT f (Node left right) = Node (mapLT f left) (mapLT f right)

-- | 7.40
reflect :: LeafTree a -> LeafTree a
reflect (Leaf x) = Leaf x
reflect (Node left right) = Node (reflect right) (reflect left)

-- | 7.42
mapR :: (a -> b) -> Rose a -> Rose b
mapR f (Bud x) = Bud (f x)
mapR f (Br roses) = Br (map (mapR f) roses)

-- | 7.46
genUnion :: (Eq a) => [[a]] -> [a]
genUnion = foldr union []

genIntersect :: (Eq a) => [[a]] -> [a]
genIntersect = foldr1 intersect

-- | 7.47
insrt :: (Ord a) => a -> [a] -> [a]
insrt x [] = [x]
insrt x (y : ys) = if x <= y then (x : y : ys) else y : (insrt x ys)

srt :: (Ord a) => [a] -> [a]
srt = foldr insrt []

-- | 7.51
ln' :: [a] -> Natural
ln' = foldl (\n _ -> S n) Z

-- Skipped those about Tower of Hanoi