Resolved Problems of the Trees exercises module

Tree.hs

{-# LANGUAGE NoMonomorphismRestriction #-}
module Tree where

  -- Example of how ADT's work by implementing the List type
  -- data List a
  --   = EmptyList -- []
  --   | ConsList a (List a) -- (1:[])
  -- (1:2:[])
  -- (ConsList 1 (ConsList 2 EmptyList))

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

  -- Different Examples of Tree Structures:
  --  Leaf
  
  --  Node (Leaf) "Hello" (Leaf)
  --  Hello
  --    - Leaf
  --    - Leaf

  --  Node (Node (Leaf) "World" (Leaf)) "Hello" (Leaf)
  --  Hello
  --    - World
  --      - Leaf
  --      - Leaf
  --    - Leaf

  -- 1.
  single :: a -> Tree a
  single value = Node Leaf value Leaf 

  -- 2.
  size :: Tree a -> Int
  size Leaf = 0
  size (Node l v r) = 1 + size l + size r
  
  -- 3.
  height :: Tree a -> Int
  height Leaf = 0
  height (Node l _ r) = 1 + max (height l) (height r)

  -- 4.
  flatten :: Tree a -> [a]
  flatten Leaf = []
  flatten (Node l v r) = flatten l ++ [v] ++ flatten r

  -- 5.
  reverse' :: Tree a -> Tree a
  reverse' Leaf = Leaf
  reverse' (Node l v r) = Node (reverse' r) v (reverse' l)

  -- 6.
  treeSort :: (Ord a) => [a] -> Tree a
  treeSort [] = Leaf
  treeSort (x:xs) = Node (treeSort lower) x (treeSort upper)
    where
      -- lower = [a | a <- xs, a < x]
      lower = filter (< x) xs
      -- upper = [a | a <- xs, a >= x]
      upper = filter (>= x) xs

  -- Example of function composition
  sortWithTree :: (Ord a) => [a] -> [a]
  sortWithTree = flatten . treeSort

  -- 7. BST Tim's Solution
  -- This is the most efficient given that it stops as soon
  -- as the conditions on the parents is not valid.
  bst :: (Ord a) => Tree a -> Bool
  bst Leaf = True
  bst (Node Leaf x Leaf) = True
  bst (Node l@(Node _ a _) x r@(Node _ b _)) = 
    a <= x && x <= b && bst l && bst r 
  bst (Node Leaf x r@(Node _ b _)) = x <= b && bst r
  bst (Node l@(Node _ a _) x Leaf) = a <= x && bst l
  
  -- 7. BST Roman's Solution
  -- This is not the most efficient, however, it shows how
  -- you can fold a tree, and show how any ADT's that 
  -- represent a Collection can be foldable
  foldTree :: (a -> b -> b -> b) -> b -> Tree a -> b
  foldTree _  zero Leaf = zero
  foldTree fn zero (Node l v r) = fn v (foldTree fn zero l) (foldTree fn zero r)

  bst' = snd . foldTree fn (Nothing, True)
    where
      fn v (_, False) (_, _)         = (Nothing, False)
      fn v (_, _) (_, False)         = (Nothing, False)
      fn v (Nothing, a) (Nothing, b) = (Just v, a && b)
      fn v (Nothing, a) (Just r,  b) = (Just v, v <= r && a && b)
      fn v (Just l,  a) (Nothing, b) = (Just v, l < v && a && b)
      fn v (Just l,  a) (Just r,  b) = (Just v, l < v && v <= r && a && b)

  -- Exercise 4 using foldTree
  flatten' = foldTree concat3 []
    where
      concat3 v l r = l ++ [v] ++ r