module Tree where -- Binary tree -- data Tree a = Leaf -- DELETE | Node a (Tree a) (Tree a) -- FOR deriving Show -- LECTURE -- Insert an element into an ordered binary tree -- insertTree :: Ord a => a -> Tree a -> Tree a insertTree x Leaf = Node x Leaf Leaf -- DELETE insertTree x (Node y tree1 tree2) -- FOR | x < y = Node y (insertTree x tree1) tree2 -- THE | otherwise = Node y tree1 (insertTree x tree2) -- LECTURE -- Search for an item in an ordered binary tree -- searchTree :: Ord a => a -> Tree a -> Bool searchTree x Leaf = False -- DELETE searchTree x (Node y tree1 tree2) -- THIS | x == y = True -- FOR | x < y = searchTree x tree1 -- THE | otherwise = searchTree x tree2 -- LECTURE -- test data testTree:: Tree Int testTree = Node 4 (Node 2 (Node 1 Leaf Leaf) (Node 3 Leaf Leaf)) (Node 6 Leaf (Node 7 Leaf Leaf)) -- Auxilliary functions -- -------------------- -- insert a list of values into tree insertAll:: [Int] -> Tree Int -> Tree Int insertAll [] tree = tree insertAll (x:xs) tree = insertAll xs (insertTree x tree) -- The following code was not discussed in the lecture -- (no need to understand what's going on here, but 'showTree' -- and printTree are useful to test your functions) -- prints a tree on console as simple ASCII diagram printTree:: (Tree Int) -> IO () printTree = putStrLn . showTree -- converts a tree into a crude string representation. showTree:: (Tree Int)-> String showTree tree = unlines trd where (_,_,trd)= (showTreeLines tree) -- returns -- 1) the tree string as list of lines, -- 2) x-position of root node -- 3) width of the tree (length of one line) showTreeLines:: (Tree Int) -> (Int, Int, [String]) showTreeLines Leaf = (0,0,[""]) showTreeLines (Node x stree gtree) = (gSize + sSize + spaces, mid, ((replicate sSize ' ') ++ xstr ++ (replicate gSize ' ')) : (zipConnected sSize gSize spaces (leftConnect' (sSize, sMid, sLines)) (rightConnect' (gSize, gMid, gLines)))) where (sSize, sMid, sLines) = showTreeLines stree (gSize, gMid, gLines) = showTreeLines gtree xstr' = show x xstr = if length xstr' == 1 then xstr' else (" " ++ xstr') spaces = if length xstr' == 1 then 1 else 3 mid = if length xstr' == 1 then sSize + 1 else sSize + 2 -- Combines two trees to one picture by placing them -- next to each other -- Arguments: -- s: width of left subtree -- g: width of right subtree -- spaces: no of spaces to be inserted between the two trees -- zipConnected:: Int-> Int -> Int -> [String] -> [String]-> [String] zipConnected _ _ _ [] [] = [] zipConnected s g spaces (str1:rstrs1)(str2:rstrs2) = (str1 ++ (replicate spaces ' ') ++str2) : (zipConnected s g spaces rstrs1 rstrs2) zipConnected s g spaces [] (str2:rstrs2) = ((replicate (s+spaces) ' ') ++ str2): (zipConnected s g spaces [] rstrs2) zipConnected s g spaces (str1:rstrs1) [] = (str1 ++ (replicate (g+spaces) ' ')): (zipConnected s g spaces rstrs1 []) -- Given a tree in list of string representation, -- adds the connection of the root node to a -- new root node places left (right) of it leftConnect'::(Int, Int, [String]) -> [String] leftConnect' (width, mid, strs) = reverse (slashblock width mid) ++ strs where slashblock width curr | curr == 0 = [] | width <= curr = [(replicate (width - 1) ' ') ++ "/"] | otherwise = ((replicate (curr - 1) ' ') ++ "/" ++ (replicate (width - curr) ' ')) : (slashblock width (curr+1)) rightConnect' (width, mid, strs) = (reverse (slashblock width mid)) ++ strs where slashblock width curr | curr == 0 = [] | curr <= 1 = ["\\" ++ (replicate (width - 1) ' ')] | otherwise = ((replicate (curr - 1) ' ') ++ "\\" ++ (replicate (width - curr) ' ')) : (slashblock width (curr-1))