assignment10.mdwn

   1 -- from the Glasgow Haskell Compiler sources (/Control/Monad/State/Strict.hs)
   2
   3 -- An example from /The Craft of Functional Programming/, Simon
   4 -- Thompson (<http://www.cs.kent.ac.uk/people/staff/sjt/>),
   5 -- Addison-Wesley 1999: \"Given an arbitrary tree, transform it to a
   6 -- tree of integers in which the original elements are replaced by
   7 -- natural numbers, starting from 0.  The same element has to be
   8 -- replaced by the same number at every occurrence, and when we meet
   9 -- an as-yet-unvisited element we have to find a \'new\' number to match
  10 -- it with:\"
  11 --
  12 -- > data Tree a = Nil | Node a (Tree a) (Tree a) deriving (Show, Eq)
  13 -- > type Table a = [a]
  14 --
  15 -- > numberTree :: Eq a => Tree a -> State (Table a) (Tree Int)
  16 -- > numberTree Nil = return Nil
  17 -- > numberTree (Node x t1 t2)
  18 -- >        =  do num <- numberNode x
  19 -- >              nt1 <- numberTree t1
  20 -- >              nt2 <- numberTree t2
  21 -- >              return (Node num nt1 nt2)
  22 -- >     where
  23 -- >     numberNode :: Eq a => a -> State (Table a) Int
  24 -- >     numberNode x
  25 -- >        = do table <- get
  26 -- >             (newTable, newPos) <- return (nNode x table)
  27 -- >             put newTable
  28 -- >             return newPos
  29 -- >     nNode::  (Eq a) => a -> Table a -> (Table a, Int)
  30 -- >     nNode x table
  31 -- >        = case (findIndexInList (== x) table) of
  32 -- >          Nothing -> (table ++ [x], length table)
  33 -- >          Just i  -> (table, i)
  34 -- >     findIndexInList :: (a -> Bool) -> [a] -> Maybe Int
  35 -- >     findIndexInList = findIndexInListHelp 0
  36 -- >     findIndexInListHelp _ _ [] = Nothing
  37 -- >     findIndexInListHelp count f (h:t)
  38 -- >        = if (f h)
  39 -- >          then Just count
  40 -- >          else findIndexInListHelp (count+1) f t
  41 --
  42 -- numTree applies numberTree with an initial state:
  43 --
  44 -- > numTree :: (Eq a) => Tree a -> Tree Int
  45 -- > numTree t = evalState (numberTree t) []
  46 --
  47 -- > testTree = Node "Zero" (Node "One" (Node "Two" Nil Nil) (Node "One" (Node "Zero" Nil Nil) Nil)) Nil
  48 -- > numTree testTree => Node 0 (Node 1 (Node 2 Nil Nil) (Node 1 (Node 0 Nil Nil) Nil)) Nil
  49 --
  50 -- sumTree is a little helper function that does not use the State monad:
  51 --
  52 -- > sumTree :: (Num a) => Tree a -> a
  53 -- > sumTree Nil = 0
  54 -- > sumTree (Node e t1 t2) = e + (sumTree t1) + (sumTree t2)