home *** CD-ROM | disk | FTP | other *** search
/ PSION CD 2 / PsionCDVol2.iso / Programs / 876 / hugs.sis / Tree.hs < prev    next >
Encoding:
Text File  |  2000-09-21  |  2.1 KB  |  57 lines
  1. module Tree where
  2. import Gofer
  3.  
  4. -- Here are a collection of fairly standard functions for manipulating
  5. -- one form of binary trees
  6.  
  7. data Tree a = Lf a | Tree a :^: Tree a
  8.  
  9. reflect t@(Lf x)  = t
  10. reflect (l:^:r)   = r :^: l
  11.  
  12. mapTree f (Lf x)  = Lf (f x)
  13. mapTree f (l:^:r) = mapTree f l :^: mapTree f r
  14.  
  15. -- Functions to calculate the list of leaves on a tree:
  16.  
  17. leaves, leaves'  :: Tree a -> [a]
  18.  
  19. leaves (Lf l)     = [l]                     -- direct version
  20. leaves (l:^:r)    = leaves l ++ leaves r
  21.  
  22. leaves' t         = leavesAcc t []          -- using an accumulating parameter
  23.                     where leavesAcc (Lf l)  = (l:)
  24.                           leavesAcc (l:^:r) = leavesAcc l . leavesAcc r
  25.  
  26. -- Picturing a tree:
  27.  
  28. drawTree :: Show a => Tree a -> IO ()
  29. drawTree  = putStr . unlines . thd3 . pic
  30.  where pic (Lf a)  = (1,1,["-- "++show a])
  31.        pic (l:^:r) = (hl+hr+1, hl+1, top pl ++ mid ++ bot pr)
  32.                      where (hl,bl,pl) = pic l
  33.                            (hr,br,pr) = pic r
  34.                            top        = zipWith (++) (replicate (bl-1) "   " ++
  35.                                                       [" ,-"] ++
  36.                                                       replicate (hl-bl) " | ")
  37.                            mid        = ["-| "]
  38.                            bot        = zipWith (++) (replicate (br-1) " | " ++
  39.                                                       [" `-"] ++
  40.                                                       replicate (hr-br) "   ")
  41.  
  42. -- Finally, here is an example due to Richard Bird, which uses lazy evaluation
  43. -- and recursion to create a `cyclic' program which avoids multiple traversals
  44. -- over a data structure:
  45.  
  46. replaceAndMin m (Lf n)  =  (Lf m, n)
  47. replaceAndMin m (l:^:r) =  (rl :^: rr, ml `min` mr)
  48.                            where (rl,ml) = replaceAndMin m l
  49.                                  (rr,mr) = replaceAndMin m r
  50.  
  51. replaceWithMin t = mt where (mt,m) = replaceAndMin m t
  52.  
  53. sample, sample2, sample4 :: Num a => Tree a
  54. sample  = (Lf 12 :^: (Lf 23 :^: Lf 13)) :^: Lf 10
  55. sample2 = sample  :^: sample
  56. sample4 = sample2 :^: sample2
  57.