bintree.hs

module Main where
  data BTree a = Nil | Node (BTree a) a  (BTree a)
      deriving (Show, Eq)

  inverse :: BTree a -> BTree a
  inverse Nil = Nil
  inverse (Node a b c) = Node (inverse c) b (inverse a)

  buildBalanced :: [a] -> BTree a
  buildBalanced []   = Nil
  buildBalanced xs = Node (buildBalanced $ take half xs)
                            (xs !! half)
                            (buildBalanced $ drop (half+1) xs)
                            where half = length xs `quot` 2

  tests :: [(BTree Int, BTree Int)]
  tests = [
      l 1 ==> l 1,
      n (l 1) 2 (l 3) ==> n (l 3) 2 (l 1),
      n (n (l 1) 2 (l 3)) 4 (n (l 6) 7 (l 9)) ==> n (n (l 9) 7 (l 6)) 4 (n (l 3) 2 (l 1)),
      n (l 2) 3 (n (l 1) 4 (l 5)) ==> n (n (l 5) 4 (l 1)) 3 (l 2),
      buildBalanced [1..50] ==> (inverse $ buildBalanced [1..50])
    ]
   where
    (==>) = (,)
    l = \a -> Node Nil a Nil
    n = Node

  tester :: (Show a, Eq a) => (BTree a, BTree a) -> IO ()
  tester (input, expected) = if actual == expected
                                 then putStr "."
                                 else do
                                     putStrLn "Error! Got: "
                                     print actual
                                     putStrLn "Expected: "
                                     print expected
    where
      actual = inverse input

  main :: IO ()
  main = mapM_ tester tests