This file provides a Haskell module with a data type for binary trees and functions to manipulate them.

Tree.hs

-- File: Tree.hs
-- Date: 11-Nov-2008
-- Version: 1.0
--
-- Copyright (C) 2008 Julia Koslowski, Jan Gosmann <[email protected]>
--
-- See: http://www.hyper-world.de
--
-- Description: This file provides a Haskell module with a data type for binary
--              trees and functions to manipulate them.

module Tree where

import Data.List

-- Data type which represents binary trees.
-- Possible constructors:
--   - EmptyNode: Empty node as the name suggests.
--   - Node: Normal node in the tree with a value a.
--       - Left branch of the tree.
--       - Value of the node.
--       - Right branch of the tree.
data Tree a = EmptyNode | 
              Node (Tree a) a (Tree a)
              deriving (Eq)

-- Use the showTree function to show the tree.
-- See also: printTree, printTreeV, showTree, showTreeV
instance Show a => Show (Tree a) where
  show t = showTree t

--------------------------------------------------------------------------------
-- Functions to build a tree from a given list of elements.
--------------------------------------------------------------------------------

-- Builds a new search tree from the given list and returns it. All left
-- subnodes of a node will have a smaller value than this node and all right
-- subnodes a greater value.
-- ATTENTION: The result of this function is unclear if a value occurs more
--            often than once in the list.
-- Arguments:
--   - List of values used to build the search tree.
-- See also: newBalancedTree
newSearchTree :: Ord a => [a] -> Tree a
newSearchTree elements = newBalancedTree (sort elements)

-- Builds a balanced tree, meaning that this function tries to give every branch
-- of the tree the same number of subnodes. The resulting tree is returned.
-- Arguments:
--   - List with the values to build the tree from.
-- See also: newSearchTree
newBalancedTree :: [a] -> Tree a
newBalancedTree []       = EmptyNode
newBalancedTree elements =
  Node (newBalancedTree left) value (newBalancedTree right)
  -- We use the first element of the right list as node value, because if one
  -- part of the splitted list is shorter than the other it will be the left.
  where (left, (value:right)) = splitAt (div (length elements) 2) elements                            

--------------------------------------------------------------------------------
-- Functions to retreive nodes from trees.
--------------------------------------------------------------------------------

-- Searches for an element in a search tree and returns the correspondig node.
-- If it is not found EmptyNode will be returned.
-- Arguments:
--   - Search tree to search in.
--   - Element to find.
-- ATTENTION: This function can only be used with search trees! You may use the
--            newSearchTree function to build these.
-- See also: getNode
findInTree :: Ord a => Tree a -> a -> Tree a
findInTree EmptyNode _ = EmptyNode
findInTree (Node l value r) item
  | item == value = (Node l value r)
  | item <  value = findInTree l item
  | item >  value = findInTree r item

-- Returns a node from a tree. You describe the node to return with a string
-- consisting only of the letters 'l' and 'r', whereby 'l' means to go to the
-- left branch of the current node and 'r' stands for the right branch. Left
-- to right in the string is top to bottom in the tree.
-- If passed path does not exist it will be returned EmptyNode.
-- Arguments:
--   - Tree to search in.
--   - String describing the path to take (see description above).
-- See also: findInTree
getNode :: Tree a -> String -> Tree a
getNode EmptyNode    _        = EmptyNode
getNode node         ""       = node
getNode (Node l _ r) (p:path)
  | p == 'l'  = getNode l path
  | p == 'r'  = getNode r path
  | otherwise = error ("getNode: Path must only contain 'l' and 'r', found: '"
                       ++ (p : "'"))

--------------------------------------------------------------------------------
-- Some functions for retaining some information about a tree.
--------------------------------------------------------------------------------

-- Returns the height of a tree (without EmptyNodes).
-- Arguments:
--   - Tree to get the height of.
-- See also: countNodes
treeHeight :: Tree a -> Int
treeHeight EmptyNode = 0
treeHeight (Node l _ r) = max (treeHeight l) (treeHeight r) + 1

-- Returns the number of nodes in a given tree (without EmptyNodes).
-- Arguments:
--   - Tree to return the number of nodes of.
-- See also: treeHeight
countNodes :: Tree a -> Int
countNodes EmptyNode = 0
countNodes (Node l _ r) = 1 + countNodes l + countNodes r

--------------------------------------------------------------------------------
-- The following part contains functions to show a tree in a nice format.
--------------------------------------------------------------------------------

-- The following functions do not need to check whether n < 0. This is done by
-- kindly be the replicate function.

-- Returns a string consisting of n spaces.
-- Arguments:
--   - Lenqth of the string = number of spaces.
nspace :: Int -> String
nspace n = replicate n ' '

-- Returns a string consisting of n underscores.
-- Arguments:
--   - Length of the string = number of underscores.
nunderscore :: Int -> String
nunderscore n = replicate n '_'

-- Returns a string consisting of spaces. The length of the string is determined
-- by how much space would be needed to show a.
-- Arguments:
--   - Something showable which is used to determine the length of the string.
space :: Show a => a -> String
space a = replicate (length (show a)) ' '

-- Adds the element fill the number of times to list needed to fill list up to
-- the length n and returns this list.
-- Arg
fillList :: Int -> a -> [a] -> [a]
fillList n fill list = list ++ (replicate (n - (length list)) fill)

-- Fills all lists in lists with the Element fill until all lists in lists have
-- the length of the longest list in lists.
makeSameLength :: [[a]] -> a -> [[a]]
makeSameLength lists fill = map (fillList (maximum (map length lists)) fill)
                                lists

-- This function generates a triple containing a string as third element which
-- represents the passed tree as ASCII graphic. The first and second value are
-- used only for internal calculation in the function.
-- Arguments:
--   - Tree to display.
-- Returns: A triple with the following elements:
--   - An index marking the center of the returned string (rounded down).
--   - The number of character from the center to the end of the string
--     (rounded up).
--   - String representing the passed tree as ASCII graphic.
-- See also: showTreeV
genShowTree :: Show a => Tree a -> (Int, Int, String)
genShowTree EmptyNode = (0, 1, ".")
genShowTree (Node l value r) =
  ( center, fill, 
    -- We use unlines to put all the lines together, but we don't want the last
    -- newline added by unlines. Therefore we have to delete it with init.
    init (unlines ( [
        -- Generate a line containing the value of the current node and paths
        -- to both subnodes.
        nspace (center_l + 1) ++ nunderscore (fill_l - 1) ++ show value
          ++ nunderscore center_r,
        -- Generate a line with the path ends.
        nspace center_l ++ "/" ++ nspace (fill_l - 1) ++ space value
          ++ nspace center_r ++ "\\" ]
      -- Add the lines for the subtrees. To get the formatting right spaces have
      -- to be added to every line of the left subtree graphic, then the left
      -- and right lines are paired.
      ++ (zipWith (++) (zipWith (++)
        (l_lines) (replicate (length l_lines) (space value)) ) (r_lines) ) )

  ))
  where
    -- Generate the output for the subtrees.
    (center_l, fill_l, left)  = genShowTree l
    (center_r, fill_r, right) = genShowTree r
    -- We have to make sure that the number of lines for both subtrees is the 
    -- same. Otherwise we would lose lines by the zipWidth function used above.
    lr_lines = makeSameLength [lines left, lines right] ""
    -- Moreover all lines of the left subtree have to be of the same length to
    -- get the formatting right.
    l_lines  = makeSameLength (head lr_lines) ' '
    r_lines  = last lr_lines
    -- ... and finally calculate the new center and fill value.
    center = (center_l + fill_l + div (length (show value)    ) 2)
    fill   = (center_r + fill_r + div (length (show value) + 1) 2)

-- Returns a string containing a horizontally oriented ASCII graphic of the
-- given tree.
-- Arguments:
--   - Tree to output.
-- See also: printTree, showTreeV, printTreeV
showTree :: Show a => Tree a -> String
showTree t = (\(a, b, c) -> c) (genShowTree t)

-- Prints the tree as horizontally oriented ASCII graphic.
-- Arguments:
--   - The tree to print
-- See also: showTree, showTreeV, printTreeV
printTree :: Show a => Tree a -> IO()
printTree t = putStr (showTree t)

--------------------------------------------------------------------------------
-- The following part contains a function to display a tree vertically instead
-- of horizontal.
--------------------------------------------------------------------------------

-- Prints the tree as vertically oriented ASCII graphic.
-- Arguments:
--   - The tree to print.
-- See also: showTreeV, showTree, printTree
printTreeV :: Show a => Tree a -> IO()
printTreeV t = putStr (showTreeV t)

-- Returns a string containing a vertically oriented ASCII graphic of the given
-- tree.
-- Arguments:
--   - Tree to output.
-- See also: printTreeV, showTree, printTree
showTreeV :: Show a => Tree a -> String
showTreeV = init . unlines . (\(a, b, c) -> c) . picture 

-- This function is similar to genShowTree. Differens: It shows the tree
-- vertically.
-- Arguments:
--   -Tree to display

picture EmptyNode = (1, 1, ["** "]) -- end Nodes of the Tree("Leafs")
picture (Node EmptyNode x EmptyNode) = (1,1,["** "++show x])
picture (Node l x r) = (hl+hr+1, hl+1, top pl ++ middle ++ bottom pr) --Node needs a
  -- value x and the left & right side of the Tree
    where (hl,bl,pl) = picture l
          (hr,br,pr) = picture r
          top        = zipWith (++) (replicate (bl-1) "   " ++
                       [" ,-"] ++
                       replicate (hl-bl) " | ")  -- Add the lines (the way) to a new Node
                                                 -- at the left or right
          middle        = [show x]         -- show value (x) in the middle 
          bottom        = zipWith (++) (replicate (br-1) " | " ++
                       [" `-"] ++         -- Displays a kind of edge before a new Node starts.
                       replicate (hr-br) "   ")

--------------------------------------------------------------------------------
-- NOTE: Only temporary stuff for testing purposes is following. Everything
--       below this mark should be removed before a release.
--------------------------------------------------------------------------------
-- E.g. Trees to test the functions showTree, showTreeV, printTree, printTreeV:


tree1 = Node (Node EmptyNode 4 (Node EmptyNode 5 EmptyNode)) 7

          (Node (Node (Node EmptyNode 8 EmptyNode) 9 EmptyNode) 

          11 (Node EmptyNode 12 EmptyNode))

tree2  = Node (Node EmptyNode 1 (Node EmptyNode 2 EmptyNode)) 3

          (Node (Node (Node EmptyNode 7 EmptyNode) 7 EmptyNode) 

          1 (Node EmptyNode 0 EmptyNode))